CONST ColorMain = 0
CONST ColorBrightF = 1
CONST ColorBrightS = 2
CONST ColorDarkS = 3
CONST ColorDarkF = 4
CONST ColorEnable = 5
CONST ColorDisable = 4
CONST ColorError = 6
CONST ColorTitle = 7
CONST ColorWarn = 8
CONST KeyUp = 1
CONST KeyDown = 2
CONST KeyFace = 3
CONST True = "1"
CONST False = "0"
CONST Forms = 1
CONST Menus = 2
CONST SaveSize = 200
CONST FileLeng = 11

TYPE pixel
        x AS INTEGER
        y AS INTEGER
END TYPE
TYPE Title
        Title AS STRING * 20
        x AS INTEGER
        y AS INTEGER
END TYPE
TYPE Choose
        object AS STRING * 100
        Totle AS INTEGER
        Now AS INTEGER
        x AS INTEGER
        y AS INTEGER
END TYPE
TYPE IsName
        Names AS STRING * 5
        FileRAM AS STRING * 6
END TYPE
TYPE Basic
        Wite AS INTEGER
        High AS INTEGER
        Size AS INTEGER
END TYPE
TYPE Form
        LT AS pixel
        Info AS Basic
        Names AS IsName
        Title AS Title
        Longest AS INTEGER
        WordX AS INTEGER
        WordY AS INTEGER
        Choose AS Choose
END TYPE
TYPE Event
        EName AS STRING * 5
        ERecord AS INTEGER
END TYPE

DEFINT I-K

DECLARE FUNCTION GetHigh% (Wite AS INTEGER, Size AS INTEGER)
DECLARE FUNCTION GetSize% (Wite AS INTEGER, High AS INTEGER)
DECLARE FUNCTION Trim$ (Str AS STRING)
DECLARE FUNCTION WarnInf$ (WarnRecord AS INTEGER)
DECLARE FUNCTION GetFileRAM$ ()
DECLARE FUNCTION GetFileName$ (Nam AS IsName)
DECLARE SUB CreateForm (NewForm AS Form)
DECLARE SUB ErrorInf (ErrRecord AS INTEGER)
DECLARE SUB DrawButtom (Left AS INTEGER, Top AS INTEGER, Wite AS INTEGER, High AS INTEGER, Class AS INTEGER)
DECLARE SUB DoEvent (Events AS Event)
DECLARE SUB CreateColor (ColorRecord AS INTEGER, Red AS INTEGER, Green AS INTEGER, Blue AS INTEGER)
DECLARE SUB SetPalette (Class AS INTEGER)
DECLARE SUB OverEnd ()

DIM SHARED EventShared AS Event
DIM SHARED FileName AS STRING

RANDOMIZE TIMER
SCREEN 12
CLEAR , , 15000
CALL SetPalette(1)
FOR i = 1 TO 1000
        CIRCLE (RND * 600 + 29, RND * 440 + 20), 20, RND * 15
NEXT
DIM Form1 AS Form
Form1.LT.x = RND * 450
Form1.LT.y = RND * 300
Form1.Choose.object = "1.Create a New Menu;2.Exit;3.End;"
Form1.Title.Title = "Demo Form"
Form1.Names.Names = "Form1"
CALL CreateForm(Form1)
END

SUB CreateColor (CR AS INTEGER, Red AS INTEGER, Green AS INTEGER, Blue AS INTEGER)
        OUT &H3C8, CR
        OUT &H3C9, Red: OUT &H3C9, Green: OUT &H3C9, Blue
END SUB

SUB CreateForm (NF AS Form)
       
        DIM Tobject AS STRING, l AS INTEGER, s AS STRING * 1
        DIM SaveDisk AS STRING * 1, Time AS INTEGER
       
        SaveDisk = False
        NF.Names.FileRAM = GetFileRAM$
        NF.Choose.Totle = 0
        NF.Longest = 0

        IF NF.LT.y < 0 THEN NF.LT.y = 0
        IF NF.LT.x < 0 THEN NF.LT.x = 0

        Tobject = Trim$(NF.Choose.object)
        l = LEN(Tobject)
        IF l = 0 THEN IF WarnInf(101) = False THEN EXIT SUB ELSE Tobject = "Unknow;"

        IF RIGHT$(Tobject, 1) <> ";" THEN IF WarnInf(100) = True THEN Tobject = Tobject + ";": l = l + 1
        FOR i = 1 TO l
                IF RIGHT$(LEFT$(Tobject, i), 1) = ";" THEN NF.Choose.Totle = NF.Choose.Totle + 1
        NEXT
        IF NF.Choose.Now < 1 THEN NF.Choose.Now = 1
        IF NF.Choose.Now > NF.Choose.Totle THEN NF.Choose.Now = NF.Choose.Totle
        DIM object(NF.Choose.Totle) AS STRING: j = 1
        object(0) = Trim$(NF.Title.Title)
        IF object(0) = "" THEN IF WarnInf(102) = False THEN EXIT SUB ELSE object(0) = "None"
        FOR i = 1 TO l
                s = RIGHT$(LEFT$(Tobject, i), 1)
                IF s = ";" THEN j = j + 1 ELSE IF j <= NF.Choose.Totle THEN object(j) = object(j) + s
        NEXT
        Tobject = ""
        FOR i = 1 TO NF.Choose.Totle
                object(i) = Trim$(object(i))
                IF object(i) = "" THEN IF WarnInf(103) = False THEN EXIT SUB ELSE object(i) = "None"
                IF NF.Longest < LEN(object(i)) THEN NF.Longest = LEN(object(i))
        NEXT
        IF LEN(object(0)) > NF.Longest THEN object(0) = LEFT$(object(0), NF.Longest)
       
        NF.LT.x = INT(NF.LT.x / 8) * 8
        NF.LT.y = INT(NF.LT.y / 16) * 16
        NF.WordX = NF.LT.x / 8 + 2
        NF.WordY = NF.LT.y / 16 + 4
        NF.Title.x = NF.WordX + INT((NF.Longest - LEN(object(0))) / 2)
        NF.Title.y = NF.WordY - 2
        NF.Info.Wite = (NF.Longest + 2) * 8
        NF.Info.High = ((NF.Choose.Totle + 1) * 2 + 1) * 16
        NF.Info.Size = GetSize(NF.Info.Wite, NF.Info.High)
        NF.Choose.y = NF.WordY + (NF.Choose.Now - 1) * 2
       
        IF NF.WordX + NF.Longest > 79 THEN CALL ErrorInf(101): EXIT SUB
        IF NF.WordY + (NF.Choose.Totle - 1) * 2 > 28 THEN CALL ErrorInf(102): EXIT SUB
        IF NF.LT.y + NF.Info.High > 479 THEN CALL ErrorInf(103): EXIT SUB
        IF NF.LT.x + NF.Info.Wite > 639 THEN CALL ErrorInf(104): EXIT SUB
       
        IF NF.Info.Size > SaveSize THEN SaveDisk = True: NF.Info.Size = SaveSize
        DIM SaveBack(NF.Info.Size) AS DOUBLE
        IF SaveDisk = False THEN
                GET (NF.LT.x, NF.LT.y)-(NF.LT.x + NF.Info.Wite, NF.LT.y + NF.Info.High), SaveBack
        ELSE
                l = GetHigh(NF.Info.Wite, NF.Info.Size): Time = INT(NF.Info.High / l)
                IF GetFileName(NF.Names) = False THEN CALL ErrorInf(2000): EXIT SUB
                OPEN NF.Names.FileRAM + NF.Names.Names FOR RANDOM AS #1 LEN = 8
                FOR i = 0 TO Time - 1
                        GET (NF.LT.x, NF.LT.y + i * l)-(NF.LT.x + NF.Info.Wite, NF.LT.y + (i + 1) * l), SaveBack
                        FOR j = 0 TO NF.Info.Size: PUT #1, , SaveBack(j): NEXT
                NEXT
                GET (NF.LT.x, NF.LT.y + Time * l)-(NF.LT.x + NF.Info.Wite, NF.LT.y + NF.Info.High), SaveBack
                CLOSE #1
        END IF
        CALL DrawButtom(NF.LT.x, NF.LT.y, NF.Info.Wite, NF.Info.High, KeyUp)
        COLOR ColorTitle: LOCATE NF.Title.y, NF.Title.x: PRINT object(0)
        COLOR ColorDisable
        FOR i = 1 TO NF.Choose.Totle
                LOCATE NF.WordY + (i - 1) * 2, NF.WordX: PRINT object(i)
        NEXT
        CALL DrawButtom((NF.WordX - 1) * 8 - 2, (NF.Choose.y - 1) * 16 - 2, LEN(object(NF.Choose.Now)) * 8 + 4, 20, KeyUp)
        COLOR ColorEnable: LOCATE NF.Choose.y, NF.WordX: PRINT object(NF.Choose.Now)
        DO
                i$ = INKEY$
                SELECT CASE i$
                        CASE CHR$(0) + CHR$(72)
                                GOSUB Front
                                IF NF.Choose.Now > 1 THEN NF.Choose.Now = NF.Choose.Now - 1 ELSE NF.Choose.Now = NF.Choose.Totle
                                GOSUB Back
                        CASE CHR$(0) + CHR$(80)
                                GOSUB Front
                                IF NF.Choose.Now < NF.Choose.Totle THEN NF.Choose.Now = NF.Choose.Now + 1 ELSE NF.Choose.Now = 1
                                GOSUB Back
                        CASE CHR$(13)
                                CALL DrawButtom((NF.WordX - 1) * 8 - 2, (NF.Choose.y - 1) * 16 - 2, LEN(object(NF.Choose.Now)) * 8 + 4, 20, KeyDown)
                                COLOR ColorEnable: LOCATE NF.Choose.y, NF.WordX: PRINT object(NF.Choose.Now)
                                Choose$ = RIGHT$(object(NF.Choose.Now), 4)
                                IF Choose$ = "Exit" OR Choose$ = "EXIT" THEN EXIT DO
                                Choose$ = RIGHT$(object(NF.Choose.Now), 3)
                                IF Choose$ = "End" OR Choose$ = "END" THEN CALL OverEnd
                                EventShared.EName = NF.Names.Names: EventShared.ERecord = NF.Choose.Now
                                CALL DoEvent(EventShared)
                        CASE CHR$(27): EXIT DO
                END SELECT
        LOOP
        IF SaveDisk = False THEN
                PUT (NF.LT.x, NF.LT.y), SaveBack, PSET
        ELSE
                PUT (NF.LT.x, NF.LT.y + Time * l), SaveBack, PSET
                OPEN NF.Names.FileRAM + NF.Names.Names FOR RANDOM AS #1 LEN = 8
                FOR i = 0 TO Time - 1
                        FOR j = 0 TO NF.Info.Size: GET #1, , SaveBack(j): NEXT
                        PUT (NF.LT.x, NF.LT.y + i * l), SaveBack, PSET
                NEXT
                CLOSE #1
                KILL NF.Names.FileRAM + NF.Names.Names
                FileName = LEFT$(FileName, LEN(FileName) - FileLeng)
        END IF
        DO: LOOP UNTIL INKEY$ = ""
        EXIT SUB
Front:
        CALL DrawButtom((NF.WordX - 1) * 8 - 2, (NF.Choose.y - 1) * 16 - 2, LEN(object(NF.Choose.Now)) * 8 + 4, 20, KeyFace)
        COLOR ColorDisable: LOCATE NF.Choose.y, NF.WordX: PRINT object(NF.Choose.Now)
RETURN
Back:
        NF.Choose.y = NF.WordY + (NF.Choose.Now - 1) * 2
        CALL DrawButtom((NF.WordX - 1) * 8 - 2, (NF.Choose.y - 1) * 16 - 2, LEN(object(NF.Choose.Now)) * 8 + 4, 20, KeyUp)
        COLOR ColorEnable: LOCATE NF.Choose.y, NF.WordX: PRINT object(NF.Choose.Now)
RETURN
END SUB

SUB DoEvent (ET AS Event)
        SELECT CASE Trim$(ET.EName)
                CASE "Form1"
                        SELECT CASE ET.ERecord
                                CASE 1: IF LEN(FileName) / FileLeng > 50 THEN CALL ErrorInf(1): EXIT SUB
                                        DIM Form1 AS Form
                                        Form1.LT.x = RND * 450
                                        Form1.LT.y = RND * 300
                                        Form1.Choose.object = "1.Create a New Form;2.Exit;3.End;"
                                        Form1.Title.Title = "Form(" + RIGHT$(STR$(LEN(FileName) / FileLeng), LEN(STR$(LEN(FileName) / FileLeng)) - 1) + ")"
                                        Form1.Names.Names = "Form1"
                                        CALL CreateForm(Form1)
                                CASE ELSE: CALL ErrorInf(105)
                        END SELECT
                CASE ELSE: CALL ErrorInf(106)
        END SELECT
END SUB

SUB DrawButtom (LT AS INTEGER, TP AS INTEGER, WT AS INTEGER, HG AS INTEGER, CS AS INTEGER)
        IF LT < 0 THEN CALL ErrorInf(1000): EXIT SUB
        IF TP < 0 THEN CALL ErrorInf(1001): EXIT SUB
        IF WT < 0 THEN CALL ErrorInf(1002): EXIT SUB
        IF HG < 0 THEN CALL ErrorInf(1003): EXIT SUB
        IF LT + WT > 639 THEN CALL ErrorInf(1004): EXIT SUB
        IF TP + HG > 479 THEN CALL ErrorInf(1005): EXIT SUB
        DIM CI(4) AS INTEGER
        SELECT CASE CS
                CASE KeyUp
                        CI(0) = ColorBrightF: CI(1) = ColorBrightS
                        CI(3) = ColorDarkS: CI(4) = ColorDarkF
                CASE KeyDown
                        CI(0) = ColorDarkS: CI(1) = ColorDarkF
                        CI(3) = ColorBrightF: CI(4) = ColorBrightS
        END SELECT
        CI(2) = ColorMain
        LINE (LT, TP)-(LT + WT, TP), CI(0)
        LINE (LT, TP)-(LT, TP + HG), CI(0)
        LINE (LT + 1, TP + 1)-(LT + WT, TP + 1), CI(1)
        LINE (LT + 1, TP + 1)-(LT + 1, TP + HG), CI(1)
        LINE (LT + 2, TP + 2)-(LT + WT - 2, TP + HG - 2), CI(2), BF
        LINE (LT + 1, TP + HG - 1)-(LT + WT - 1, TP + HG - 1), CI(3)
        LINE (LT + WT - 1, TP + 1)-(LT + WT - 1, TP + HG - 1), CI(3)
        LINE (LT, TP + HG)-(LT + WT, TP + HG), CI(4)
        LINE (LT + WT, TP)-(LT + WT, TP + HG), CI(4)
END SUB

SUB ErrorInf (ER AS INTEGER)
        SOUND 1200, .5
        SELECT CASE ER
                CASE 1: Err$ = "Too many forms!"
                CASE 101: Err$ = "Form.WordX>MAX(79)!"
                CASE 102: Err$ = "Form.WordY>MAX(26)!"
                CASE 103: Err$ = "Form.Button>MAX(479)!"
                CASE 104: Err$ = "Form.Right>MAX(639)!"
                CASE 105: Err$ = "No this Choose Event for Form!"
                CASE 106: Err$ = "No this Form!"
                CASE 1000: Err$ = "DrawButtom.Left<MIN(0)!"
                CASE 1001: Err$ = "DrawButtom.Top<MIN(0)!"
                CASE 1002: Err$ = "DrawButtom.Wite<MIN(0)!"
                CASE 1003: Err$ = "DrawButtom.High<MIN(0)!"
                CASE 1004: Err$ = "DrawButtom.Right>MAX(639)!"
                CASE 1005: Err$ = "DrawButtom.Button>MAX(479)!"
                CASE 2000: Err$ = "File exist!"
                CASE 2001: Err$ = "Error in FileName!"
                CASE ELSE: Err$ = "Unknow Error!"
        END SELECT
        DIM BackSave(GetSize(440, 26)) AS DOUBLE
        GET (100, 218)-(540, 244), BackSave
        CALL DrawButtom(100, 218, 440, 26, KeyUp)
        CALL DrawButtom(210, 221, 325, 20, KeyDown)
        COLOR ColorWarn: LOCATE 15, 15: PRINT "ERROR("; RIGHT$(STR$(ER), LEN(STR$(ER)) - 1); ")"
        COLOR ColorError: LOCATE 15, 28: PRINT Err$;
        DO: LOOP UNTIL INKEY$ = CHR$(27)
        PUT (100, 218), BackSave, PSET
        ERASE BackSave
END SUB

FUNCTION GetFileName$ (Nam AS IsName)
        DIM FiNa AS STRING * FileLeng
        FiNa = Nam.FileRAM + Nam.Names
        OPEN FiNa FOR RANDOM AS #1: CLOSE #1
        OPEN FiNa FOR INPUT AS #1
        IF EOF(1) THEN GetFileName$ = FiNa: FileName = FileName + FiNa:  ELSE GetFileName$ = False
        CLOSE #1
END FUNCTION

FUNCTION GetFileRAM$
        GetFileRAM$ = "~~" + HEX$(RND * 61439 + 4096)
END FUNCTION

FUNCTION GetHigh% (WT AS INTEGER, SZ AS INTEGER)
        GetHigh% = (SZ * 16 - WT * 8) / (WT + 8)
END FUNCTION

FUNCTION GetSize% (WT AS INTEGER, HG AS INTEGER)
        GetSize% = WT / 16 * HG + (WT + HG) / 2
END FUNCTION

SUB OverEnd
        DIM l AS INTEGER
        l = LEN(FileName)
        CLS
        IF l MOD FileLeng <> 0 THEN
                CALL ErrorInf(2001)
                IF WarnInf(1000) = True THEN KILL "~~*.*": End$ = "Killed!" ELSE End$ = "Have about" + STR$(CINT(l / FileLeng)) + " Files left!"
                CALL SetPalette(0)
                COLOR 15: LOCATE 14, 15 + 30 - LEN(End$): PRINT End$
        ELSE
                CALL SetPalette(0)
                FOR i = 1 TO l STEP FileLeng
                        File$ = MID$(FileName, i, FileLeng)
                        KILL File$
                NEXT
                COLOR 15: LOCATE 14, 28: PRINT "Press any key to end..."
        END IF
        a$ = INPUT$(1)
        END
END SUB

SUB SetPalette (CS AS INTEGER)
        OUT &H3C6, 255
        IF CS THEN
        OUT &H3C8, 0
        OUT &H3C9, 43: OUT &H3C9, 43: OUT &H3C9, 43
        OUT &H3C9, 63: OUT &H3C9, 63: OUT &H3C9, 63
        OUT &H3C9, 53: OUT &H3C9, 53: OUT &H3C9, 53
        OUT &H3C9, 33: OUT &H3C9, 33: OUT &H3C9, 33
        OUT &H3C9, 23: OUT &H3C9, 23: OUT &H3C9, 23
        OUT &H3C9, 0: OUT &H3C9, 0: OUT &H3C9, 0
        OUT &H3C9, 63: OUT &H3C9, 0: OUT &H3C9, 0
        OUT &H3C9, 63: OUT &H3C9, 0: OUT &H3C9, 63
        OUT &H3C9, 63: OUT &H3C9, 63: OUT &H3C9, 0
        ELSE
        OUT &H3C8, 0
        FOR i = 0 TO 15: OUT &H3C9, 43: OUT &H3C9, 43: OUT &H3C9, 43: NEXT
        OUT &H3C8, 15
        OUT &H3C9, 30: OUT &H3C9, 0: OUT &H3C9, 40
        END IF
END SUB

FUNCTION Trim$ (Str AS STRING)
        DIM l AS INTEGER
        l = LEN(Str)
        FOR i = 1 TO l
                IF RIGHT$(LEFT$(Str, i), 1) <> CHR$(32) THEN EXIT FOR
        NEXT
        Str = RIGHT$(Str, l + 1 - i)
        l = LEN(Str)
        FOR i = l TO 1 STEP -1
                IF RIGHT$(LEFT$(Str, i), 1) <> CHR$(32) THEN EXIT FOR
        NEXT
        Trim$ = LEFT$(Str, i)
END FUNCTION

FUNCTION WarnInf$ (WR AS INTEGER)
        WarnInf$ = False
        SOUND 1000, .5
        SELECT CASE WR
                CASE 100: Warn$ = "Warn in Form.Object->';'!"
                CASE 101: Warn$ = "Warn in Form.Object->''!"
                CASE 102: Warn$ = "Warn in Form.Title->''!"
                CASE 103: Warn$ = "Warn in Form.Object(i)->''!"
                CASE 200: Warn$ = "Warn in Menu.Object->';'!"
                CASE 201: Warn$ = "Warn in Menu.Object->''!"
                CASE 202: Warn$ = "Warn in Menu.Title->''!"
                CASE 203: Warn$ = "Warn in Menu.Object(i)->''!"
                CASE 1000: Warn$ = "Killed them?!"
                CASE ELSE: Warn$ = "Unknow Warn!"
        END SELECT
        DIM BackSave(GetSize(440, 26)) AS DOUBLE
        GET (100, 218)-(540, 244), BackSave
        CALL DrawButtom(100, 218, 440, 26, KeyUp)
        CALL DrawButtom(200, 221, 335, 20, KeyDown)
        COLOR ColorError: LOCATE 15, 15: PRINT "WARN("; RIGHT$(STR$(WR), LEN(STR$(WR)) - 1); ")"
        COLOR ColorWarn: LOCATE 15, 27: PRINT Warn$; "(Y/N)?"
        DO
                i$ = INKEY$
                IF i$ = "Y" OR i$ = "y" OR i$ = "N" OR i$ = "n" THEN EXIT DO
        LOOP
        IF i$ = "Y" OR i$ = "y" THEN WarnInf$ = True
        PUT (100, 218), BackSave, PSET
        ERASE BackSave
END FUNCTION