'Variable type to hold screen design item data.
TYPE DesignType
    ImageNo AS INTEGER
    Xpos AS INTEGER
    Ypos AS INTEGER
    DisAct AS INTEGER
END TYPE

DECLARE SUB InitPaletteData (filename$, PaletteArray&())
DECLARE SUB InitDesignData (filename$, DesignArray() AS DesignType)
DECLARE SUB InitImageData (filename$, ImageArray%())
DECLARE SUB MakeImageIndex (ImageArray%(), IndexArray%())
DECLARE SUB DisplayDesign (DesignArray() AS DesignType, ImageArray%(), ImageIndex%(), ClsAction%)
DECLARE SUB ChangePalette (PaletteArray&())
DECLARE SUB WizzText (Text$, TopLine%, ImageArray%(), IndexArray%())
DECLARE FUNCTION GetDepth% (ImNo%, ImageArray%(), IndexArray%())
DECLARE FUNCTION GetWidth% (ImNo%, ImageArray%(), IndexArray%())
DEFINT A-Z
'$INCLUDE: 'gslib.bi'

CLS
SCREEN 13
COLOR 2
PRINT "5k8Y l3v3l 3d1t0r v3r510n 1"
reload:
CLEAR

' palette.
filename$ = "skate.pal"
DIM pal(512)
DEF SEG = VARSEG(pal(0))
BLOAD filename$, 0
i = 0
FOR c = 0 TO 255
  OUT &H3C8, c
  OUT &H3C9, PEEK(i)
  OUT &H3C9, PEEK(i + 1)
  OUT &H3C9, PEEK(i + 2)
  i = i + 4
NEXT
DEF SEG



'images
REDIM SHARED imgs(1 TO 48)
REDIM SHARED iindex(1 TO 48)
InitImageData "skat.put", imgs()
MakeImageIndex imgs(), iindex()



CLS

X = 1
y = 1

DIM SHARED Map(20, 12)

FOR doy = 1 TO 12
FOR dox = 1 TO 20
Map(dox, doy) = 9
NEXT
NEXT

DO
oldx = X
oldy = y
k$ = INKEY$
SELECT CASE k$
CASE "t":
CLS
FOR ex% = 0 TO 319 STEP 16
im = im + 1
PUT (ex%, 1), imgs(iindex(im)), PSET
NEXT ex%
SLEEP
CASE "a": X = X - 1
CASE "d": X = X + 1
CASE "s": y = y + 1
CASE "w": y = y - 1
CASE ">", ".": ttp = ttp + 1
CASE "<", ",": ttp = ttp - 1
CASE " ": Map(X, y) = ttp
CASE "m":
CLS
INPUT "File Name (no extension): ", filny$
filny$ = filny$ + ".map"
OPEN filny$ FOR OUTPUT AS #1
FOR wy = 0 TO 12
FOR eg = 0 TO 20
WRITE #1, Map(eg, wy)
NEXT
NEXT
CLOSE #1
CASE "l":
CLS
INPUT "File Name (no extension): ", filny$
filny$ = filny$ + ".map"
OPEN filny$ FOR INPUT AS #1
FOR wy = 0 TO 12
FOR eg = 0 TO 20
INPUT #1, Map(eg, wy)
NEXT
NEXT
CLOSE #1
CASE "n":
GOTO reload
END SELECT

IF X <> oldx OR y <> oldy THEN LINE (oldx * 16 - 16, oldy * 16 - 16)-(oldx * 16, oldy * 16), 0, BF

IF ttp > 43 THEN ttp = 1
IF ttp < 1 THEN ttp = 43
IF X < 1 THEN X = 1
IF X > 20 THEN X = 20
IF y < 1 THEN y = 1
IF y > 12 THEN y = 12



FOR dy% = 0 TO 12
FOR dx% = 0 TO 20
IF Map(dx%, dy%) > 0 THEN
IF dx% <> X OR dy% <> y THEN
GSsolidPUT dx% * 16 - 16, dy% * 16 - 16, &HA000, 0, VARSEG(imgs(iindex(Map(dx%, dy%)))), VARPTR(imgs(iindex(Map(dx%, dy%))))
END IF
END IF
NEXT
NEXT

'put the cursor, with a blue dot on each corner
GSsolidPUT X * 16 - 16, y * 16 - 16, &HA000, 0, VARSEG(imgs(iindex(ttp))), VARPTR(imgs(iindex(ttp)))
GSPSET X * 16 - 16, y * 16 - 16, &HA000, 0, 1
GSPSET X * 16 - 1, y * 16 - 1, &HA000, 0, 1
GSPSET X * 16 - 16, y * 16 - 1, &HA000, 0, 1
GSPSET X * 16 - 1, y * 16 - 16, &HA000, 0, 1



'start again
nd:
LOOP UNTIL k$ = CHR$(27)

DO
INPUT "Save level?", sm$
LOOP UNTIL LCASE$(sm$) = "y" OR LCASE$(sm$) = "n"

IF LCASE$(sm$) = "y" THEN
OPEN filny$ FOR OUTPUT AS #1
FOR wy = 0 TO 12
FOR eg = 0 TO 20
WRITE #1, Map(eg, wy)
NEXT
NEXT
CLOSE #1
END IF

REM $DYNAMIC
'* ChangePalette() subroutine:
'* Quickly changes the current colour palette to the colours held in
'* a palette array.
'*
'* Parameters:
'* PaletteArray&() - Long integer array holding the colours to be used as
'*                   the new colour palette. This array must have previously
'*                   been initialized by calling InitPaletteData().
'*
SUB ChangePalette (PaletteArray&())

    'Break down all 256 colours into their RGB values.
    DIM RGBval(0 TO 255, 0 TO 2)
    FOR n = 0 TO 255
        c& = PaletteArray&(n)
        b = c& \ 65536: c& = c& - b * 65536
        g = c& \ 256: c& = c& - g * 256
        r = c&
        RGBval(n, 0) = r
        RGBval(n, 1) = g
        RGBval(n, 2) = b
    NEXT n

    'Write colours directly to the video card.
    WAIT &H3DA, &H8, &H8: WAIT &H3DA, &H8
    FOR n = 0 TO 255
        OUT &H3C8, n            'Select attribute.
        OUT &H3C9, RGBval(n, 0) 'Write red.
        OUT &H3C9, RGBval(n, 1) 'Write green.
        OUT &H3C9, RGBval(n, 2) 'Write blue.
    NEXT n

END SUB

'* DisplayDesign() subroutine:
'* Displays the screen design held in DesignArray() using the images held
'* in ImageArray().
'*
'* Parameters:
'* DesignArray() - Dynamic, DesignType array holding screen design data.
'*  ImageArray() - Dynamic, integer array holding the images to use for
'*                 displaying the screen design.
'*  IndexArray() - Dynamic, integer array holding the index for images in
'*                 ImageArray().
'*     ClsAction - A non-zero value causes the screen to be cleared before
'*                 the screen design is displayed.
'*
SUB DisplayDesign (DesignArray() AS DesignType, ImageArray(), ImageIndex(), ClsAction)

    'Only clear the screen if requested to.
    IF ClsAction THEN CLS

    LastItem = UBOUND(DesignArray)

    'Loop to display all items in the screen design.
    FOR n = 1 TO LastItem
        ImageNo = DesignArray(n).ImageNo
        Xpos = DesignArray(n).Xpos
        Ypos = DesignArray(n).Ypos
        DisAct = DesignArray(n).DisAct

        'Mask-out high byte of DisAct to find display action code.
        SELECT CASE (DisAct AND &HFF)
            CASE 1
                PUT (Xpos, Ypos), ImageArray(ImageIndex(ImageNo)), PSET
            CASE 2
                PUT (Xpos, Ypos), ImageArray(ImageIndex(ImageNo)), PRESET
            CASE 3
                PUT (Xpos, Ypos), ImageArray(ImageIndex(ImageNo)), OR
            CASE 4
                PUT (Xpos, Ypos), ImageArray(ImageIndex(ImageNo)), XOR
            CASE 5
                PUT (Xpos, Ypos), ImageArray(ImageIndex(ImageNo)), AND
        END SELECT
    NEXT n

END SUB

'* GetDepth() function:
'* Returns the depth (in pixels) of any image contained in an image array.
'*
'* Parameters:
'*         ImNo - The number of the image to return the depth of.
'* ImageArray() - Image array that contains the image.
'* IndexArray() - Index array for the images in ImageArray().
'*
FUNCTION GetDepth (ImNo, ImageArray(), IndexArray())

    GetDepth = ImageArray(IndexArray(ImNo) + 1)

END FUNCTION

'* GetWidth() function:
'* Returns the width (in pixels) of any image contained in an image array.
'*
'* Parameters:
'*         ImNo - The number of the image to return the width of.
'* ImageArray() - Image array that contains the image.
'* IndexArray() - Index array for the images in ImageArray().
'*
FUNCTION GetWidth (ImNo, ImageArray(), IndexArray())

    GetWidth = ImageArray(IndexArray(ImNo)) \ 8

END FUNCTION

'* InitDesignData() subroutine:
'* Initializes a DesignType array with screen design data - this must be done
'* before displaying a screen design using the DisplayDesign() routine. The
'* calling value of FileName$ dictates whether the data should be read
'* directly from a screen design file or from DATA statements (see below).
'*
'* Parameters:
'*     FileName$ - The name of the screen design file to load. This must
'*                 include the path to the file if it does not reside in the
'*                 current directory. If FileName$ is an empty string (""),
'*                 screen design data is read from DATA statements.
'* DesignArray() - Dynamic, DesignType array to hold the screen design data.
'*
'* Note: Before calling InitDesignData() to initialize a screen design from
'*       DATA statements, use an appropriate RESTORE statement to ensure the
'*       correct DATA statements are read.
'*
SUB InitDesignData (filename$, DesignArray() AS DesignType)

    IF filename$ <> "" THEN
        '***** Read screen design data from file *****

        'Establish size of DesignType array required.
        FileNo = FREEFILE
        OPEN filename$ FOR BINARY AS #FileNo
        ItemCount = (LOF(FileNo) - 7) \ 8
        CLOSE #FileNo
        REDIM DesignArray(0 TO ItemCount) AS DesignType

        'Load screen design data directly into array memory.
        DEF SEG = VARSEG(DesignArray(0))
        BLOAD filename$, 0
        DEF SEG
    ELSE
        '***** Read screen design data from DATA statements *****

        'Establish size of DesignType array required.
        READ ItemCount
        REDIM DesignArray(0 TO ItemCount) AS DesignType

        'READ screen design DATA into array.
        FOR n = 1 TO ItemCount
            READ ImageNo, Xpos, Ypos, DisAct
            DesignArray(n).ImageNo = ImageNo
            DesignArray(n).Xpos = Xpos
            DesignArray(n).Ypos = Ypos
            DesignArray(n).DisAct = DisAct
        NEXT n
    END IF

END SUB

'* InitImageData() subroutine:
'* Initializes an integer array with image data - this must be done before
'* displaying an image using the PUT(graphics) statement. The calling value
'* of FileName$ dictates whether the data should be read directly from an
'* image file or from DATA statements (see below).
'*
'* Parameters:
'*    FileName$ - The name of the image file to load. This must include the
'*                path to the file if it does not reside in the current
'*                directory. If FileName$ is an empty string (""), image
'*                data is read from DATA statements.
'* ImageArray() - Dynamic, integer array to hold the image data.
'*
'* Note: Before calling InitImageData() to initialize images from DATA
'*       statements, use an appropriate RESTORE statement to ensure the
'*       correct DATA statements are read.
'*
SUB InitImageData (filename$, ImageArray())

    IF filename$ <> "" THEN
        '***** Read image data from file *****

        'Establish size of integer array required.
        FileNo = FREEFILE
        OPEN filename$ FOR BINARY AS #FileNo
        Ints = (LOF(FileNo) - 7) \ 2
        CLOSE #FileNo
        REDIM ImageArray(1 TO Ints)

        'Load image data directly into array memory.
        DEF SEG = VARSEG(ImageArray(1))
        BLOAD filename$, 0
        DEF SEG
    ELSE
        '***** Read image data from DATA statements *****

        'Establish size of integer array required.
        READ IntCount
        REDIM ImageArray(1 TO IntCount)

        'READ image DATA into array.
        FOR n = 1 TO IntCount
            READ X
            ImageArray(n) = X
        NEXT n
    END IF

END SUB

'* InitPaletteData() subroutine:
'* Initializes a long integer array with palette colour data - this must be
'* done before changing palettes with the PALETTE USING statement. The
'* calling value of FileName$ dictates whether the data should be read
'* directly from a palette file or from DATA statements (see below).
'*
'* Parameters:
'*       FileName$ - The name of the palette file to load. This must include
'*                   the path to the file if it does not reside in the
'*                   current directory. If FileName$ is an empty string (""),
'*                   palette data is read from DATA statements.
'* PaletteArray&() - Dynamic, long integer array to hold palette data.
'*
'* Note: Before calling InitPaletteData() to initialize a palette from DATA
'*       statements, use an appropriate RESTORE statement to ensure the
'*       correct DATA statements are read.
'*
SUB InitPaletteData (filename$, PaletteArray&())

    'Size array to hold all 256 colours.
    REDIM PaletteArray&(0 TO 255)

    IF filename$ <> "" THEN
        '*** Read palette data from file ***
        FileNo = FREEFILE
        OPEN filename$ FOR BINARY AS #FileNo
        FOR n = 0 TO 255
            GET #FileNo, , colour&
            PaletteArray&(n) = colour&
        NEXT n
        CLOSE #FileNo
    ELSE
        '*** Read palette data from DATA statements ***
        FOR n = 0 TO 255
            READ colour&
            PaletteArray&(n) = colour&
        NEXT n
    END IF

END SUB

'* MakeImageIndex() subroutine:
'* Constructs an image position index for the images held in an image array.
'*
'* Parameters:
'* ImageArray() - Dynamic, integer array holding images to be indexed.
'* IndexArray() - Dynamic, integer array to hold the index for images in
'*                ImageArray().
'*
SUB MakeImageIndex (ImageArray(), IndexArray())

    'The index will initially be built in a temporary array, allowing
    'for the maximum 1000 images per file.
    DIM Temp(1 TO 1000)
    Ptr& = 1: IndexNo = 1: LastInt = UBOUND(ImageArray)
    DO
        Temp(IndexNo) = Ptr&
        IndexNo = IndexNo + 1

        'Evaluate descriptor of currently referenced image to
        'calculate the beginning of the next image.
        X& = (ImageArray(Ptr&) \ 8) * (ImageArray(Ptr& + 1)) + 4
        IF X& MOD 2 THEN X& = X& + 1
        Ptr& = Ptr& + (X& \ 2)
    LOOP WHILE Ptr& < LastInt

    LastImage = IndexNo - 1

    'Copy the image index values into the actual index array.
    REDIM IndexArray(1 TO LastImage)
    FOR n = 1 TO LastImage
        IndexArray(n) = Temp(n)
    NEXT n

END SUB

