QB64/QB64-PE
QB64/QB64-PE
1
1
Fork 0
mirror of https://github.com/QB64-Phoenix-Edition/QB64pe.git synced 2024-07-06 01:10:23 +00:00
Code Issues Releases Wiki Activity
QB64-PE/programs/samples/qb45com/action/arqanoid/lvldesgn.bas

1049 lines
22 KiB
QBasic
Raw Blame History

DECLARE SUB ErrorDialog ()
DECLARE SUB NewFile ()
DECLARE SUB PutTileBG ()
DECLARE FUNCTION Menu% ()
DECLARE SUB EditLevel (Lvl%)
DECLARE SUB RestoreColors ()
DECLARE SUB HideBuild ()
DECLARE SUB ReadRGB (C%, R%, G%, B%)
DECLARE SUB SaveColors ()
DECLARE SUB OpenFile (File$)
DECLARE FUNCTION Confirmsave% (File$, Lvl%)
DECLARE SUB PrintFonts (X%, Y%, N$)
DECLARE SUB Printnum (X%, Y%, N$)
DECLARE SUB DrawStatusArea ()
DECLARE SUB InitColors ()
DECLARE FUNCTION FastKB% ()
DECLARE SUB DrawLevelBG (BGMode%, ColorStep%, ColorAttr%)
DECLARE SUB WriteRGB (C%, R%, G%, B%)
DECLARE SUB DrawSpike (X%, Y%)
DECLARE SUB DrawTile (X%, Y%, Clr%)
DECLARE SUB GetTileBackGround ()
DECLARE SUB DrawBorder ()
DECLARE SUB EditTile ()
DECLARE SUB SaveFile (File$)
DECLARE SUB InitFonts ()
DECLARE SUB InitNums ()
DEFINT A-Z
'==========Type declarations====================================
TYPE TileType
X AS INTEGER
Y AS INTEGER
C AS INTEGER
END TYPE
TYPE RGBtype
R AS INTEGER
G AS INTEGER
B AS INTEGER
END TYPE
'$DYNAMIC
'====================Constants==================================
'Misc Const
CONST False = 0, True = NOT False
'Screen const
CONST MinX = 0, MaxX = 260, MinY = 0, MaxY = 200
'KeyConstants
CONST KRight = 77, KLeft = 75, KDown = 80, Kup = 72, KEsc = 1
CONST KW = &H11, KA = &H1E, KS = &H1F, KD = &H20, KPGD = &H51
CONST KSpc = &H39, KEnt = &H1C, KDel = &H53, KF5 = &H3F
CONST KTab = &HF
'Color Const
CONST BorderMin = 40, Bordermax = 47
CONST SpikeMin = 50, SpikeMax = 57
CONST TcolorMin = 60, TcolorMax = 93
CONST FColorMin = 96, FcolorMax = 100
CONST SnColorMin = 101, SnColorMax = 105
'Offset and Tile Const
CONST OffsetBG = 122 'TileY=19(0 to 180/6), TileX=12(0 to 220/20)
CONST TileMax = 227 '0 to 227
CONST TileW = 19, TileH = 5 ' 0 to 19, 0 to 5 (20*6)
'Font constant
CONST FontOffset = 12 'Size of SmallFonts
'==================Shared Arrays===================
DIM SHARED BackGround(27816) AS INTEGER'BackGround for erasing tiles
DIM SHARED TBG(122) AS INTEGER
DIM SHARED Tile(TileMax) AS TileType
DIM SHARED SavRGB(0 TO 255) AS RGBtype
DIM SHARED SavRGBlvl(130 TO 193) AS RGBtype
'==================Shared Variables================
DIM SHARED Finished
DIM SHARED TX, TY, TCC, Tidx, Lvl, ColorAttr
'==================Non-Global Arrays===============
DIM SmallFonts(396) AS INTEGER
DIM SmallNum(132) AS INTEGER
DIM SHARED Path$
RANDOMIZE TIMER
CLS
SCREEN 13
'Path$ = "C:\qbasic\Arqanoid\"
Path$ = ""
ON ERROR GOTO ErrorHand
ColorAttr = 1 + INT(RND * 7)
ColorStep = 1 + INT(RND * 80)
Lvl = 0
InitColors
TX = 0
TY = 0
TCC = 1
Tidx = 0
SaveColors
HideBuild
InitFonts
InitNums
DrawLevelBG 1, ColorStep, ColorAttr
GetTileBackGround
DrawStatusArea
RestoreColors
'GOTO Temp
Finished = False
DO
EditTile
LOOP UNTIL Finished
C$ = INPUT$(1)
CLS
SCREEN 0
END
ErrorHand:
RESUME NEXT
'=============temp===================
'====================================
Temp:
END
REM $STATIC
FUNCTION Confirmsave (File$, Lvl) STATIC
Confirmsave = False
DIM Temp(4500)
GET (30, 140)-STEP(200, 35), Temp
LINE (30, 140)-STEP(200, 35), 0, BF
LINE (30, 140)-STEP(200, 35), 14, B
PrintFonts 35, 152, "are you sure you want to save? Y,N:"
DO
PrintFonts 80, 142, "@@@@ Warning!!! @@@@"
K$ = ""
K$ = INKEY$
SELECT CASE UCASE$(K$)
CASE "Y"
EXIT DO
CASE "N"
EXIT DO
CASE ELSE
END SELECT
FOR DD = 0 TO 1
FOR D! = 0 TO 32500: NEXT D!
NEXT DD
LINE (80, 142)-STEP(106, 5), 0, BF 'Blink
FOR DD = 0 TO 1
FOR D! = 0 TO 32500: NEXT D!
NEXT DD
LOOP UNTIL UCASE$(K$) = "Y" OR UCASE$(K$) = "N"
SELECT CASE UCASE$(K$)
CASE "Y"
GOSUB EnterFileName
File$ = Path$ + "Levels\" + "QbNoid" + RTRIM$(LTRIM$(STR$(Lvl))) + "." + "LVL"
PUT (30, 140), Temp, PSET
EXIT FUNCTION
CASE "N"
Confirmsave = False
PUT (30, 140), Temp, PSET
CASE ELSE
END SELECT
EXIT FUNCTION
EnterFileName:
PrintFonts 55, 162, "Enter LevelName:"
PrintFonts 135, 162, "QbNoid .Lvl"
Ok = False
Printnum 160, 162, LTRIM$(STR$(Lvl))
DO
K$ = INPUT$(1)
SELECT CASE FastKB
CASE Kup
IF Lvl < 50 THEN Lvl = Lvl + 1
LINE (170, 162)-STEP(10, 5), 0, BF
Printnum 160, 162, LTRIM$(STR$(Lvl))
CASE KDown
IF Lvl > 1 THEN Lvl = Lvl - 1
LINE (170, 162)-STEP(10, 5), 0, BF
Printnum 160, 162, LTRIM$(STR$(Lvl))
CASE KEsc
Ok = True
Confirmsave = False
CASE KEnt
Ok = True
Confirmsave = True
CASE ELSE
END SELECT
LOOP UNTIL Ok
RETURN
END FUNCTION
SUB DrawBorder STATIC
FOR I = 0 TO 6
LINE (I, I)-(260 - I, 200 - I), BorderMin + I, B
NEXT I
END SUB
SUB DrawLevelBG (BGMode, ColorStep, ColorAttr) STATIC
Clr = 145
FOR Y = 0 TO 199 STEP 5
FOR X = 0 TO 320 STEP 5
IF CC = 0 THEN
Clr = Clr + ColorStep
ELSE
Clr = Clr - ColorStep
END IF
IF BGMode = 1 THEN
LINE (X, Y)-(X + 4, Y + 4), Clr, BF
LINE (X + 1, Y + 1)-(X + 3, Y + 3), Clr + 5, BF
LINE (X + 1, Y + 1)-(X + 1, Y + 1), Clr + 11, BF
ELSE
LINE (X, Y)-(X + 4, Y + 4), Clr, B
LINE (X + 1, Y + 1)-(X + 3, Y + 3), Clr + 5, B
LINE (X + 1, Y + 1)-(X + 1, Y + 1), Clr + 11, B
END IF
IF Clr >= 180 THEN CC = 1
IF Clr <= 150 THEN CC = 0
NEXT X
NEXT Y
'Erase RightSide for Info,Scores,Etc.
LINE (MaxX, MinY)-(320, 200), 255, BF
LINE (0, 200)-(320, 200), 255, BF
'Draw Spikes
FOR X = 5 TO 250 STEP 10
DrawSpike X, 205
NEXT X
DrawBorder
END SUB
SUB DrawSpike (X, Y) STATIC
FOR I = 1 TO 5
LINE (X + I, Y)-STEP(0, -(I * 4.5)), SpikeMax - I
LINE ((X + 10) - I, Y)-STEP(0, -(I * 4.5)), SpikeMax - I
NEXT I
END SUB
SUB DrawStatusArea STATIC
PrintFonts 256, 0, "Qbnoid level"
PrintFonts 263, 10, "Designer"
PrintFonts 263, 20, "Beta Test"
PrintFonts 268, 30, "Ver"
Printnum 286, 30, "007"
PrintFonts 256, 45, "Directions:"
PrintFonts 256, 60, "Movement:"
Printnum 260, 70, "0"
PrintFonts 270, 70, "Arrows"
PrintFonts 256, 80, "Rot Color:"
Printnum 260, 90, "0"
PrintFonts 270, 90, "Space"
PrintFonts 256, 100, "Put tile:"
Printnum 260, 110, "0"
PrintFonts 270, 110, "Tab,Enter"
PrintFonts 256, 120, "Erasetile:"
Printnum 260, 130, "0"
PrintFonts 270, 130, "Delete"
PrintFonts 256, 140, "Save:"
Printnum 260, 150, "0"
PrintFonts 270, 150, "FS:FFive"
PrintFonts 256, 160, "Exit:"
Printnum 260, 170, "0"
PrintFonts 270, 170, "Escape"
PrintFonts 256, 182, "TileType:"
Printnum 300, 182, "0"
PrintFonts 270, 194, ":relsoft:"
END SUB
SUB DrawTile (X, Y, Clr)
SELECT CASE Clr
CASE 1
TB = 60
TC = 61
TM = 62
CASE 2
TB = 63
TC = 64
TM = 65
CASE 3
TB = 66
TC = 67
TM = 68
CASE 4
TB = 69
TC = 70
TM = 71
CASE 5
TB = 72
TC = 73
TM = 74
CASE 6
TB = 75
TC = 76
TM = 77
CASE 7
TB = 78
TC = 79
TM = 80
CASE 8
TB = 81
TC = 82
TM = 83
CASE 9
TB = 84
TC = 85
TM = 86
CASE ELSE
END SELECT
LINE (X, Y)-STEP(TileW, TileH), TC, BF
LINE (X, Y)-STEP(TileW, TileH), TM, B
LINE (X, Y)-STEP(0, TileH), TB
LINE (X, Y + TileH)-STEP(TileW - 1, 0), TB
END SUB
SUB EditLevel (Lvl) STATIC
DIM Temp(2000)
GET (53, 149)-(203, 170), Temp
LINE (54, 150)-(203, 170), 0, BF
LINE (54, 150)-(203, 170), 14, B
PrintFonts 95, 152, "Edit Level"
PrintFonts 55, 162, "Enter LevelName:"
PrintFonts 135, 162, "QbNoid .Lvl"
Ok = False
Printnum 160, 162, (STR$(Lvl))
DO
K$ = INPUT$(1)
SELECT CASE FastKB
CASE Kup
IF Lvl < 50 THEN Lvl = Lvl + 1
LINE (170, 162)-STEP(10, 5), 0, BF
Printnum 160, 162, (STR$(Lvl))
CASE KDown
IF Lvl > 1 THEN Lvl = Lvl - 1
LINE (170, 162)-STEP(10, 5), 0, BF
Printnum 160, 162, (STR$(Lvl))
CASE KEsc
Ok = True
PUT (53, 149), Temp, PSET
CASE KEnt
Ok = True
PutTileBG
PUT (53, 149), Temp, PSET
OpenFile Path$ + "levels\" + "qbnoid" + LTRIM$(STR$(Lvl)) + "." + "lvl"
CASE ELSE
END SELECT
LOOP UNTIL Ok
END SUB
SUB EditTile
'227
OldTX = TX
OldTY = TY
GOSUB GetBG
GOSUB DrawT
DO
CD = CD MOD 1595 + 1
IF CD = 1 THEN
CC = CC MOD 7 + 1
END IF
LINE (10 + (TX * 20), 10 + (TY * 6))-STEP(TileW, TileH), CC + BorderMin, B
LOOP WHILE INKEY$ = ""
GOSUB PutBG
SELECT CASE FastKB
CASE KRight, KD
IF TX < 11 THEN
TX = TX + 1
IF Tidx < 227 THEN Tidx = Tidx + 1
END IF
CASE KLeft, KA
IF TX > 0 THEN
TX = TX - 1
IF Tidx > 0 THEN Tidx = Tidx - 1
END IF
CASE KDown, KS
IF TY < 18 THEN
TY = TY + 1
IF Tidx <= 227 - 12 THEN Tidx = Tidx + 12
END IF
CASE Kup, KW
IF TY > 0 THEN
TY = TY - 1
IF Tidx >= 12 THEN Tidx = Tidx - 12
END IF
CASE KSpc
TCC = (TCC MOD 9) + 1
Printnum 305, 182, LTRIM$(STR$(TCC))
GOSUB DrawT
GOSUB PutBG
CASE KEnt, KTab
GOSUB DrawT
Tile(Tidx).X = 10 + TX * 20
Tile(Tidx).Y = 10 + TY * 6
Tile(Tidx).C = TCC
CASE KDel
GOSUB EraseTile
Tile(Tidx).X = 0
Tile(Tidx).Y = 0
Tile(Tidx).C = 0
CASE KF5
'Save
Con = Confirmsave(File$, Lvl)
DIM Temp(2000)
GET (50, 40)-STEP(159, 15), Temp
LINE (50, 40)-STEP(159, 15), 0, BF
LINE (50, 40)-STEP(159, 15), 14, B
IF Con = True THEN
SaveFile File$
PrintFonts 55, 45, "File Saved as:"
PrintFonts 130, 45, "QbNoid .Lvl"
Printnum 160, 45, LTRIM$(STR$(Lvl))
Con = False
ELSE
PrintFonts 55, 45, "File UnSaved "
PrintFonts 130, 45, "Press A key"
END IF
X$ = INPUT$(1)
PUT (50, 40), Temp, PSET
CASE KEsc
SELECT CASE Menu
CASE 1
NewFile
CASE 2
EditLevel Lvl
CASE 3
'Esc do nothing
CASE 4
Finished = True
CASE ELSE
END SELECT
CASE ELSE
END SELECT
EXIT SUB
DrawT:
DrawTile 10 + (TX * 20), 10 + (TY * 6), TCC
RETURN
GetBG:
GET (INT(10 + (TX * 20)), INT(10 + (TY * 6)))-STEP(19, 5), TBG
RETURN
PutBG:
PUT (INT(10 + (OldTX * 20)), INT(10 + (OldTY * 6))), TBG, PSET
RETURN
EraseTile:
PUT (INT(10 + (TX * 20)), INT(10 + (TY * 6))), BackGround(OffsetBG * Tidx), PSET
RETURN
END SUB
SUB ErrorDialog
X = 60
Y = 40
DIM Temp(5000)
GET (X, Y)-STEP(150, 60), Temp
LINE (X, Y)-STEP(150, 60), 0, BF
LINE (X, Y)-STEP(150, 60), 14, B
Number = ERR
SELECT CASE Number
CASE IS = 52
PrintFonts X + 50, Y + 2, "Error!!!!!"
PrintFonts X + 20, Y + 25, "File does not exist!!!!"
PrintFonts X + 35, Y + 52, "Press Any key..."
CASE ELSE
PrintFonts X + 50, Y + 2, "Error!!!!!"
PrintFonts X + 37, Y + 25, "Unknown Error!"
Printnum X + 60, Y + 35, (LTRIM$(RTRIM$(STR$(ERR))))
PrintFonts X + 35, Y + 52, "Press Any key..."
END SELECT
PUT (X, Y), Temp
END SUB
FUNCTION FastKB STATIC
FastKB = INP(&H60)
DO WHILE LEN(INKEY$): LOOP
END FUNCTION
SUB GetTileBackGround STATIC
I = 0
FOR Y = 0 TO 108 STEP 6
FOR X = 0 TO 220 STEP 20
GET (10 + X, 10 + Y)-STEP(19, 5), BackGround(OffsetBG * I)
I = I + 1
NEXT X
NEXT Y
END SUB
SUB HideBuild
FOR I = 0 TO 255
R = 0
G = 0
B = 0
WriteRGB I, R, G, B
NEXT I
END SUB
SUB InitColors STATIC
WriteRGB 254, 63, 63, 63
'Color for Border============================================
R = 25
G = 25
B = 40
FOR I = BorderMin TO Bordermax
IF I <= BorderMin + 3 THEN
R = R + 5
G = G + 3
ELSE
R = R - 5
G = G - 3
END IF
WriteRGB I, R, G, B
NEXT I
'FontColors================================
R = 63
G = 63
B = 63
FOR I = FColorMin TO FcolorMax
R = R - 7
B = B - 7
WriteRGB I, R, G, B
NEXT I
'SmallNum colors============================
R = 63
G = 63
B = 63
FOR I = SnColorMin TO SnColorMax
R = R - 7
G = G - 7
WriteRGB I, R, G, B
NEXT I
'Tile Colors=================================
'60-93
FOR I = TcolorMin TO TcolorMax
II = II MOD 3 + 1
IF II = 1 THEN
IC = IC MOD 9 + 1
END IF
SELECT CASE II
CASE 1
R = 10: G = 10: B = 10 'Dark Borders
CASE 2
R = 30: G = 30: B = 30 'Tilecolor
CASE 3
R = 50: G = 50: B = 50 'Light Borders
CASE ELSE
END SELECT
'Tile color
SELECT CASE IC
CASE 1
G = 0
B = 0
CASE 2
R = 0
B = 0
CASE 3
R = 0
G = 0
CASE 4
R = 0
CASE 5
G = 0
CASE 6
B = 0
CASE 7
R = 25
CASE 8
G = 25
CASE 9
B = 25
CASE ELSE
END SELECT
WriteRGB I, R, G, B
NEXT I
'BackGround Colors==============================================
I = 0
FOR I = 130 TO 193
SELECT CASE ColorAttr
CASE 1 'Red
SavRGB(I).R = I \ 2
SavRGB(I).G = 0
SavRGB(I).B = 0
CASE 2 'Green
SavRGB(I).R = 0
SavRGB(I).G = I \ 2
SavRGB(I).B = 0
CASE 3 'Blue
SavRGB(I).R = 0
SavRGB(I).G = 0
SavRGB(I).B = I \ 2
CASE 4 'Yellow
SavRGB(I).R = I \ 2
SavRGB(I).G = I \ 2
SavRGB(I).B = 0
CASE 5 'Purple
SavRGB(I).R = I \ 2
SavRGB(I).G = 0
SavRGB(I).B = I \ 2
CASE 6 'Metallic Blue
SavRGB(I).R = 0
SavRGB(I).G = I \ 2
SavRGB(I).B = I \ 2
CASE 7 'White
SavRGB(I).R = I \ 2
SavRGB(I).G = I \ 2
SavRGB(I).B = I \ 2
CASE ELSE
SavRGB(I).R = I \ 2
SavRGB(I).G = I \ 2
SavRGB(I).B = I \ 2
END SELECT
NEXT I
I = 0
FOR I = 130 TO 193
WriteRGB I, SavRGB(I).R, SavRGB(I).G, SavRGB(I).B
NEXT I
END SUB
SUB InitFonts STATIC
SHARED SmallFonts() AS INTEGER
CLS
OPEN Path$ + "images\" + "small.fnt" FOR INPUT AS #1
INPUT #1, Maxfont
'Small numbers 0 to 4 height, 0 to 3 wide
FOR I = 1 TO Maxfont
FOR Y = 0 TO 4
JC = JC MOD 5 + 1
FOR X = 0 TO 3
INPUT #1, J
IF J <> 0 THEN
PSET (X + XX, Y), JC + (FColorMin - 1)
END IF
NEXT X
NEXT Y
XX = XX + 5
NEXT I
CLOSE
NI = 0
X = 0
Y = 0
FOR I = 1 TO Maxfont
GET (X, Y)-STEP(3, 4), SmallFonts(NI * FontOffset%)
NI = NI + 1
X = X + 5
NEXT I
END SUB
SUB InitNums STATIC
SHARED SmallNum() AS INTEGER
CLS
OPEN Path$ + "images\" + "smallnum.fnt" FOR INPUT AS #1
INPUT #1, MaxNum
'Small numbers 0 to 4 height, 0 to 3 wide
FOR I = 1 TO MaxNum
FOR Y = 0 TO 4
JC = JC MOD 5 + 1
FOR X = 0 TO 3
INPUT #1, J
IF J <> 0 THEN
PSET (X + XX, Y), JC + (SnColorMin - 1)
END IF
NEXT X
NEXT Y
XX = XX + 5
NEXT I
CLOSE
NI = 0
X = 0
Y = 0
FOR I = 1 TO 11
GET (X, Y)-STEP(3, 4), SmallNum(NI * FontOffset)
NI = NI + 1
X = X + 5
NEXT I
END SUB
FUNCTION Menu
DIM Temp(2100)
GET (93, 43)-(167, 96), Temp
LINE (95, 43)-(167, 96), 0, BF
LINE (95, 43)-(167, 96), 14, B
PrintFonts 110, 46, "Menu:"
PrintFonts 95, 55, "N: New File"
PrintFonts 95, 65, "E: Edit File"
PrintFonts 95, 75, "ESC: EXitMenu"
PrintFonts 95, 85, "X: Exit LVDES"
Temp$ = "N" + "E" + CHR$(27) + "X"
DO
K$ = UCASE$(INPUT$(1))
M = INSTR(Temp$, K$)
LOOP UNTIL M > 0
PUT (93, 43), Temp, PSET
Menu = M
END FUNCTION
SUB NewFile STATIC
Lvl = 0
PutTileBG
'Refresh
FOR I = 0 TO TileMax
Tile(I).X = 0
Tile(I).Y = 0
Tile(I).C = 0
NEXT I
END SUB
SUB OpenFile (File$) STATIC
OPEN File$ FOR INPUT AS #1
FOR I = 0 TO TileMax
INPUT #1, Tile(I).X
INPUT #1, Tile(I).Y
INPUT #1, Tile(I).C
NEXT I
CLOSE
FOR I = 0 TO TileMax
IF Tile(I).C <> 0 THEN
DrawTile Tile(I).X, Tile(I).Y, Tile(I).C
END IF
NEXT I
END SUB
SUB PrintFonts (X, Y, N$) STATIC
SHARED SmallFonts() AS INTEGER
N$ = LTRIM$(RTRIM$(UCASE$(N$)))
Letter$ = "@.,:!?ABCDEFGHIJKLMNOPQRSTUVWXYZ "
FOR I = 1 TO LEN(N$)
II$ = MID$(N$, I, 1)
OffSet = INSTR(Letter$, II$)
PUT ((I * 5) + X, Y), SmallFonts((OffSet - 1) * FontOffset), PSET
NEXT I
END SUB
SUB Printnum (X, Y, N$) STATIC
SHARED SmallNum() AS INTEGER
FOR I = 1 TO LEN(N$)
II$ = MID$(N$, I, 1)
OffSet = INSTR("1234567890,", II$)
PUT ((I * 5) + X, Y), SmallNum((OffSet - 1) * FontOffset), PSET
NEXT I
END SUB
SUB PutTileBG STATIC
Y = 0
X = 0
I = 0
FOR Y = 0 TO 108 STEP 6
FOR X = 0 TO 220 STEP 20
PUT (10 + X, 10 + Y), BackGround(OffsetBG * I), PSET
I = I + 1
NEXT X
NEXT Y
END SUB
SUB ReadRGB (C%, R%, G%, B%)
OUT &H3C7, C%
R% = INP(&H3C9)
G% = INP(&H3C9)
B% = INP(&H3C9)
END SUB
SUB RestoreColors
FOR II = 0 TO 63
FOR I = 0 TO 255
ReadRGB I, RR, GG, BB
R = SavRGB(I).R
G = SavRGB(I).G
B = SavRGB(I).B
IF R > RR THEN
RR = RR + 1
ELSEIF R < RR THEN
RR = RR - 1
ELSE
'Do nothing
END IF
IF G > GG THEN
GG = GG + 1
ELSEIF G < GG THEN
GG = GG - 1
ELSE
'Do nothing
END IF
IF B > BB THEN
BB = BB + 1
ELSEIF B < BB THEN
BB = BB - 1
ELSE
'Do nothing
END IF
WriteRGB I, RR, GG, BB
NEXT I
NEXT II
END SUB
SUB SaveColors
FOR I = 0 TO 255
ReadRGB I, R, G, B
SavRGB(I).R = R
SavRGB(I).G = G
SavRGB(I).B = B
NEXT I
END SUB
SUB SaveFile (File$) STATIC
OPEN File$ FOR OUTPUT AS #1
FOR I = 0 TO TileMax
PRINT #1, Tile(I).X
PRINT #1, Tile(I).Y
PRINT #1, Tile(I).C
NEXT I
CLOSE
END SUB
SUB WriteRGB (C%, R%, G%, B%)
OUT &H3C8, C%
OUT &H3C9, R%
OUT &H3C9, G%
OUT &H3C9, B%
END SUB
View git blame Copy permalink