'3ds File Handler 1.3
'
'Designed by : Subhajit Sahu(GamerZ)
'Mail : qbasic40@gmail.com
'
'3ds File format
'[X resolution](lo,hi)          add 1 to get xresolution
'[Y resolution](lo,hi)          add 1 to get yresolution
'[Total slides]                 no. of slides present
'[data slide1] ..
'end FORMAT
'data format(contains only coulur nos. for screen 13)
'colour format RRGGGBBB-byte
'clr(x0y0),clr(x1y0),...
'
'Any doubts, please mail me
'I request everyone to mail me if they like it
'This isn't copyright but i request you to give a part of credit
'to me if you ever use this. Thank You programmers ...
'
'Does anyone know how to prevent eye damage caused by monitor?
'Please let me know an easy way to do so
'(i have already started to wear spectacles)
'
'Happy Fast Sprite Making ... @_@
'



'Mouse Routines
DECLARE FUNCTION mouse.init% ()
DECLARE SUB mouse.show ()
DECLARE SUB mouse.hide ()
DECLARE SUB mouse.setrange (x1%, y1%, x2%, y2%)
DECLARE SUB mouse.put (x%, y%)
DECLARE SUB mouse.status ()
DECLARE SUB mouse.relativestatus ()

'Common Routines
DECLARE SUB c.delay (seconds!)
DECLARE FUNCTION c.input$ (s$, cl%, leng%)
DECLARE SUB c.clearkey ()
DECLARE SUB c.blinkcursor (cl%, size!, delay!)
DECLARE SUB c.dispstring (s$, xx%, yy%, clr%, o%, e%, size!, ers%)
DECLARE SUB c.character (char$, xx%, yy%, clr%, size!, ers%)
DECLARE FUNCTION c.stringcount% (s$, c$)
DECLARE FUNCTION c.word$ (s$, no%)
DECLARE SUB c.filewrite (fl1$, pos1&, s$)
DECLARE FUNCTION c.fileread$ (fl1$, pos1&, l%)
DECLARE FUNCTION c.val& (s$)

DECLARE SUB win.tell (x%, y%, name$, tell$, clr1%, clr2%, clr3%, clr4%)
DECLARE FUNCTION win.ask$ (x%, y%, name$, tell$, boxes$, buttons$, clr1%, clr2%, clr3%, clr4%, clr5%)
DECLARE SUB win.menus ()
DECLARE SUB win.menu ()
DECLARE SUB win.scrolls ()
DECLARE SUB win.scroll ()
DECLARE SUB win.scrollrefresh ()
DECLARE SUB win.colours ()
DECLARE SUB win.colour ()

DECLARE SUB grp.default ()
DECLARE SUB grp.xorbox (x1%, y1%, x2%, y2%, clr%)
DECLARE SUB grp.notbox (x1%, y1%, x2%, y2%)

DECLARE SUB sof.saveram (fl1$)
DECLARE SUB sof.display (fl1$, x&, y&, sld&)
DECLARE SUB sof.write (fl1$, x%, y%, sld&, clr&)
DECLARE SUB sof.message (s$)
DECLARE SUB sof.error (s1$, s2$)
DECLARE SUB sof.pasteslide (fl1$, s1&, fl2$, s2&)
DECLARE SUB sof.writeinf ()
DECLARE SUB sof.slidenumber ()
DECLARE SUB sof.resolution ()
DECLARE SUB sof.filename ()
DECLARE SUB sof.clearslide ()

DECLARE SUB too.pencil ()
DECLARE SUB too.eraser ()
DECLARE SUB too.brush ()
DECLARE SUB too.colourengine (c$)

DECLARE FUNCTION err.filename% (fl1$)
DECLARE FUNCTION err.filepresent% (fl1$)
DECLARE FUNCTION err.slidenumber% (s1$)
DECLARE FUNCTION err.slidepresent% (fl1$, s1%)
DECLARE FUNCTION err.resolution% (fl1$, xres&, yres&)
DECLARE FUNCTION err.bmpresolution% (fl1$, xres&, yres&)

DECLARE SUB snd.click ()
DECLARE SUB asm.loadprog (fl1$, s$)
DECLARE FUNCTION nospc$ (a$)

'Constants
ON ERROR GOTO men.errors
OPTION BASE 0
CONST charlimitx1 = 21, charlimity1 = 24, charlimitx2 = 304, charlimity2 = 167, charcentrex = (charlimitx1 + charlimitx2) \ 2, charcentrey = (charlimity1 + charlimity2) \ 2, charrangex = charlimitx2 - charlimitx1 + 1, charrangey = charlimity2 -  _
charlimity1 + 1
CONST CONST.cspace = 6, CONST.linegap = 10, CONST.blinktime1 = .05, CONST.blinktime2 = 2
'Declaring Keys
CONST backspc = 8, enter = 13, htab = 9, esc = 27
CONST left = 75, right = 77, up = 72, down = 80
CONST uplt = 71, uprt = 73, dnlt = 79, dnrt = 81
CONST insert = 82, home = 73, pageup = 71, del = 83, endk = 81, pagedn = 79
CONST kf1 = 59, kf2 = 60, kf3 = 61, kf4 = 62, kf5 = 63, kf6 = 64, kf7 = 65, kf8 = 66, kf9 = 67, kf10 = 68, kf11 = 133, kf12 = 134
'Keys declared


'|||||||||||||||||||||||CFG|||||||||||||||||||||||||||||||
'$STATIC
'Load Engine
asm.loadprog "Engine.dll", Engine$

TYPE mouse
x AS INTEGER
y AS INTEGER
lb AS INTEGER
rb AS INTEGER
cs AS INTEGER
clk AS INTEGER
END TYPE
TYPE pixel
x AS LONG
y AS LONG
END TYPE

DIM Zone%(10)
DIM Lastcharpoint AS pixel, Piccentre AS pixel, Resolution AS pixel, Pointer AS pixel, Xrange AS pixel, Yrange AS pixel, MenuTask AS pixel
DIM Jerry AS mouse
DIM Jharka$(3, 8), Jharkas%(3, 1)
DIM ScrollBar(2, 1) AS SINGLE
DIM CONST.separators AS STRING

CONST.separators = CHR$(0) + "|"
Jharka$(0, 0) = "File  "
Jharka$(0, 1) = "New 3DS File"
Jharka$(0, 2) = "Open a BMP file"
Jharka$(0, 3) = "Open a 3DS file"
Jharka$(0, 4) = "Save to 3DS file"
Jharka$(0, 5) = "Save As to a 3DS file"
Jharka$(0, 6) = "Exit"
Jharka$(1, 0) = "Edit  "
Jharka$(1, 1) = "Slide Select"
Jharka$(1, 2) = "Slides State"
Jharka$(1, 3) = "View Resolution"
Jharka$(1, 4) = "Slide Paste"
Jharka$(1, 5) = "Clear Slide"
Jharka$(2, 0) = "Tools   "
Jharka$(2, 1) = "Pencil"
Jharka$(2, 2) = "Eraser"
Jharka$(2, 3) = "Brush"
Jharka$(2, 4) = "Colour Engine"
Jharka$(3, 0) = "Help  "
Jharka$(3, 1) = "User Help"
Jharka$(3, 2) = "Version"

SCREEN 13
'Check for mouse
a1% = mouse.init%
IF (a1% <> -1) THEN
PRINT "Sorry! Mouse not Installed."
k$ = INPUT$(1)
SYSTEM
END IF

grp.default
sof.display "dat.dat", 160, 100, 1
a1 = TIMER
DO UNTIL TIMER - a1 > 2.5
LOOP

LINE (charlimitx1 - 1, charlimity1 - 1)-(charlimitx2 + 1, charlimity2 + 1), 29, B
win.menus
Resolution.x = 319
Resolution.y = 199
GOSUB men.defaultize
win.scrolls
win.colours
GOSUB men.display
sof.slidenumber
sof.message "Default Resolution = 320*200"

mouse.show
'Now, I come to the rescue
DO
k$ = ""
c.clearkey
        DO
        k$ = INKEY$
        mouse.status
        LOOP WHILE (k$ = "" AND Jerry.lb = 0 AND Jerry.clk = 0 AND Jerry.rb = 0)'Wait for input

win.menu
win.scroll
win.colour

'Respond to button usage
IF (Jerry.x > 185 AND Jerry.x < 195 AND Jerry.y > 1 AND Jerry.y < 9 AND Jerry.clk = 1) THEN GOSUB men.save3ds
IF (Jerry.x > 5 AND Jerry.x < 15 AND Jerry.y > 35 AND Jerry.y < 45 AND Jerry.clk = 1) THEN GOSUB men.openbmp
IF (Jerry.x > 5 AND Jerry.x < 15 AND Jerry.y > 45 AND Jerry.y < 55 AND Jerry.clk = 1) THEN GOSUB men.open3ds
IF (Jerry.x > 5 AND Jerry.x < 15 AND Jerry.y > 65 AND Jerry.y < 75 AND Jerry.clk = 1) THEN GOSUB men.slidepaste

'Respond to tool usage
IF (k$ = CHR$(htab) OR Jerry.lb = 1) THEN
IF (Jerry.x >= charlimitx1 AND Jerry.x <= charlimitx2 AND Jerry.y >= charlimity1 AND Jerry.y <= charlimity2) THEN
        SELECT CASE Pointer.x
        CASE 0
        too.pencil
        CASE 1
        too.eraser
        CASE 2
        too.brush
        CASE ELSE
        END SELECT
END IF
END IF

'Respond to special keys
SELECT CASE k$
CASE CHR$(0) + CHR$(left)
        Jerry.x = Jerry.x - 1
        IF (Jerry.x < charlimitx1) THEN Jerry.x = charlimitx1
        mouse.put Jerry.x, Jerry.y
CASE CHR$(0) + CHR$(right)
        Jerry.x = Jerry.x + 1
        IF (Jerry.x > charlimitx2) THEN Jerry.x = charlimitx2
        mouse.put Jerry.x, Jerry.y
CASE CHR$(0) + CHR$(up)
        Jerry.y = Jerry.y - 1
        IF (Jerry.y < charlimity1) THEN Jerry.y = charlimity1
        mouse.put Jerry.x, Jerry.y
CASE CHR$(0) + CHR$(down)
        Jerry.y = Jerry.y + 1
        IF (Jerry.y > charlimity2) THEN Jerry.y = charlimity2
        mouse.put Jerry.x, Jerry.y
CASE CHR$(0) + CHR$(kf1)
        snd.click
        GOSUB men.userhelp
CASE CHR$(0) + CHR$(kf2)
        snd.click
        GOSUB men.version
CASE CHR$(0) + CHR$(kf3)
        snd.click
        GOSUB men.viewresolution
CASE CHR$(0) + CHR$(kf4)
        snd.click
        GOSUB men.slidestate
CASE CHR$(0) + CHR$(kf5)
        snd.click
        Pointer.x = 0
        GOSUB men.tool
CASE CHR$(0) + CHR$(kf6)
        snd.click
        Pointer.x = 1
        GOSUB men.tool
CASE CHR$(0) + CHR$(kf7)
        snd.click
        Pointer.x = 2
        GOSUB men.tool
CASE CHR$(0) + CHR$(kf8)
        snd.click
        GOSUB men.save3ds
CASE ELSE
END SELECT

'Respond to mouse activities
IF (MenuTask.x <> 0) THEN
Jerry.lb = 0            'Deactivate idiot type writing
SELECT CASE MenuTask.x
CASE 1
        SELECT CASE MenuTask.y
        CASE 1
        GOSUB men.new3ds
        CASE 2
        GOSUB men.openbmp
        CASE 3
        GOSUB men.open3ds
        CASE 4
        GOSUB men.save3ds
        CASE 5
        GOSUB men.saveas3ds
        CASE 6
        GOSUB men.exit
        CASE ELSE
        END SELECT
CASE 2
        SELECT CASE MenuTask.y
        CASE 1
        GOSUB men.slideselect
        CASE 2
        GOSUB men.slidestate
        CASE 3
        GOSUB men.viewresolution
        CASE 4
        GOSUB men.slidepaste
        CASE 5
        GOSUB men.clearslide
        CASE ELSE
        END SELECT
CASE 3
        SELECT CASE MenuTask.y
        CASE 1
        Pointer.x = 0
        GOSUB men.tool
        CASE 2
        Pointer.x = 1
        GOSUB men.tool
        CASE 3
        Pointer.x = 2
        GOSUB men.tool
        CASE 4
        GOSUB men.colourengine
        CASE ELSE
        END SELECT
CASE 4
        SELECT CASE MenuTask.y
        CASE 1
        GOSUB men.userhelp
        CASE 2
        GOSUB men.version
        CASE ELSE
        END SELECT
CASE ELSE
END SELECT
MenuTask.x = 0
mouse.status
END IF
LOOP



'Men's Lok Sabha
men.display:
sof.display "zzzzzzzz.ini", Piccentre.x, Piccentre.y, ActiveSlide&
RETURN

men.userhelp:
aa2$ = CHR$(enter)
aa1$ = "F1 = User Help" + aa2$ + "F2 = Version" + aa2$ + "F3 = View Resolution" + aa2$ + "F4 = Slides State" + aa2$ + "F5 = Pencil" + aa2$ + "F6 = Eraser" + aa2$ + "F7 = Brush" + aa2$ + "F8 = Save" + aa2$ + "Load Help.3ds for help"
win.tell 40, 60, "User Help" + SPACE$(10), aa1$, 10, 200, 248, 54
RETURN

men.version:
aa2$ = CHR$(enter)
aa1$ = "3DS File Handler" + aa2$ + "Version: 1 .3" + aa2$ + "Designed by: Subhajit Sahu(GamerZ)" + aa2$ + "E-mail: qbasic40@gmail.com" + aa2$ + "Please mail me."
win.tell 40, 30, "Version" + SPACE$(15), aa1$, 100, 20, 219, 54
RETURN

men.viewresolution:
aa2$ = CHR$(enter)
win.tell 80, 60, "Resolution     ", "File: " + Filename$ + aa2$ + STR$(Resolution.x + 1) + "*" + STR$(Resolution.y + 1) + " pixels", 120, 20, 29, 54
RETURN

men.tool:
SELECT CASE Pointer.x
CASE 0
sof.message "Pencil Tool Selected."
CASE 1
sof.message "Eraser Tool Selected."
CASE 2
sof.message "Brush Tool Selected."
CASE ELSE
END SELECT
RETURN

men.save3ds:
IF (Filename$ = "") THEN
aa1$ = win.ask$(80, 60, "Save 3DS File", "Enter filename:", "|FileName|", "|Accept|Cancel|", 111, 179, 22, 77, 89)
aa1% = VAL(RIGHT$(aa1$, 1))
IF (aa1% <> 1) THEN GOTO men.save3dse
aa2$ = c.word$(aa1$, 1)
IF (aa2$ = "") THEN
sof.error "No Filename     ", "Enter a filename"
GOTO men.save3dse
END IF
IF (err.filename%(aa2$) <> 0) THEN
sof.error "Invalid Filename", "Enter a correct DOS filename."
GOTO men.save3dse
END IF
IF (INSTR(aa2$, ".") = 0) THEN aa2$ = aa2$ + ".3ds"
Filename$ = aa2$
END IF
SHELL "copy zzzzzzzz.ini " + Filename$ + " >zzzzzzzy.ini"
KILL "zzzzzzzy.ini"
sof.message "File saved to " + Filename$
sof.filename
men.save3dse:
RETURN

men.new3ds:
aa1$ = win.ask$(40, 60, "New 3DS File ", "Enter the filename:", "|FileName|X Resolution|Y Resolution|", "|OK|Cancel|", 111, 19, 210, 127, 250)
aa1% = VAL(RIGHT$(aa1$, 1))
IF (aa1% <> 1) THEN GOTO men.new3dse
aa2$ = c.word$(aa1$, 1)
IF (aa2$ = "") THEN
sof.error "No Filename ", "Enter a filename"
GOTO men.new3dse
END IF
IF (err.filename%(aa2$) <> 0) THEN
sof.error "Invalid Filename", "Enter a correct DOS filename."
GOTO men.new3dse
END IF
aa3$ = c.word$(aa1$, 2)
IF (aa3$ = "") THEN
sof.error "No X Resolution  ", "Enter X resolution"
GOTO men.new3dse
END IF
Resolution.x = c.val&(aa3$) - 1
aa3$ = c.word$(aa1$, 3)
IF (aa3$ = "") THEN
sof.error "No Y Resolution  ", "Enter Y resolution"
GOTO men.new3dse
END IF
Resolution.y = c.val&(aa3$) - 1
IF (INSTR(aa2$, ".") = 0) THEN aa2$ = aa2$ + ".3ds"
Filename$ = aa2$
aa1% = FREEFILE
OPEN "O", #aa1%, Filename$
CLOSE #aa1%
KILL "zzzzzzzz.ini"
GOSUB men.defaultize
sof.message "New File " + Filename$ + " created."
GOSUB men.display
win.scrolls
men.new3dse:
RETURN

men.openbmp:
aa1$ = win.ask$(40, 70, "Open BMP File ", "Enter the 24-bit BMP filename:", "|FileName|", "|Open|Cancel|", 111, 140, 240, 127, 170)
aa2% = VAL(RIGHT$(aa1$, 1))
IF (aa2% <> 1) THEN GOTO men.openbmpe
aa2$ = c.word$(aa1$, 1)
IF (aa2$ = "") THEN
sof.error "No Filename     ", "Enter a filename"
GOTO men.openbmpe
END IF
IF (err.filename%(aa2$) <> 0) THEN
sof.error "Invalid Filename", "Enter a correct DOS filename."
GOTO men.openbmpe
END IF
IF (INSTR(aa2$, ".") = 0) THEN aa2$ = aa2$ + ".bmp"
IF (err.filepresent%(aa2$) <> 0) THEN
sof.error "File not found", "Enter a file that is present on the disk."
GOTO men.openbmpe
END IF
IF (err.bmpresolution%(aa2$, Resolution.x, Resolution.y) <> 0) THEN
IF (ActiveSlide& <> 1) THEN
sof.error "Resolution Error", "The resolution of the BMP file does not match the current resolution."
GOTO men.openbmpe
ELSE
aa1$ = win.ask$(40, 50, "Resolution Unmatch", "Change current resolution to BMP resolution to load the BMP file(any other data present will be removed)", "||", "|Yes|No|", 11, 110, 230, 67, 30)
IF (RIGHT$(aa1$, 1) = "2") THEN GOTO men.openbmpe ELSE KILL "zzzzzzzz.ini"
END IF
END IF
sof.saveram aa2$
sof.message "File " + aa2$ + " opened."
Piccentre.x = charcentrex
Piccentre.y = charcentrey
GOSUB men.display
win.scrolls
men.openbmpe:
RETURN

men.open3ds:
aa1$ = win.ask$(80, 40, "Open 3DS File", "Enter the 3DS filename:", "|FileName|Slide|", "|OK|Cancel|", 111, 120, 245, 107, 90)
aa1% = VAL(RIGHT$(aa1$, 1))
IF (aa1% <> 1) THEN GOTO men.open3dse
aa2$ = c.word$(aa1$, 1)
IF (aa2$ = "") THEN
sof.error "No Filename     ", "Enter a filename"
GOTO men.open3dse
END IF
IF (err.filename%(aa2$) <> 0) THEN
sof.error "Invalid Filename", "Enter a correct DOS filename."
GOTO men.open3dse
END IF
IF (INSTR(aa2$, ".") = 0) THEN aa2$ = aa2$ + ".3ds"
IF (err.filepresent%(aa2$) <> 0) THEN
sof.error "File not found", "Enter a file that is present on the disk."
GOTO men.open3dse
END IF
aa3& = c.val&(c.word$(aa1$, 2))
IF (aa3& <= 0) THEN
IF (err.resolution%(aa2$, Resolution.x, Resolution.y) <> 0) THEN
IF (ActiveSlide& <> 1) THEN
sof.error "Resolution Error", "The resolution of the 3DS file does not match the current resolution."
GOTO men.open3dse
ELSE
aa1$ = win.ask$(40, 50, "Resolution Unmatch", "Change current resolution to 3DS resolution to load the 3DS file(any other data present will be removed)", "||", "|Yes|No|", 11, 110, 200, 7, 190)
IF (RIGHT$(aa1$, 1) <> "1") THEN GOTO men.open3dse ELSE KILL "zzzzzzzz.ini"
END IF
END IF
END IF
Piccentre.x = charcentrex
Piccentre.y = charcentrey
IF (aa3& <= 0) THEN
SHELL "copy " + aa2$ + " zzzzzzzz.ini >zzzzzzzy.ini"
KILL "zzzzzzzy.ini"
Filename$ = aa2$
GOSUB men.display
sof.message "File " + aa2$ + " opened."
aa3$ = c.fileread$(aa2$, 1, 6)
Resolution.x = ASC(LEFT$(aa3$, 1)) + ASC(MID$(aa3$, 2, 1)) * 256
Resolution.y = ASC(MID$(aa3$, 3, 1)) + ASC(MID$(aa3$, 4, 1)) * 256
ActiveSlide& = 1
MaxSlide& = ASC(MID$(aa3$, 5, 1)) + ASC(RIGHT$(aa3$, 1)) * 256
sof.writeinf
win.scrolls
ELSE
sof.pasteslide aa2$, aa3&, "zzzzzzzz.ini", ActiveSlide&
GOSUB men.display
sof.message "Slide Copied from file " + aa2$ + " ."
END IF
men.open3dse:
RETURN

men.saveas3ds:
aa1$ = win.ask$(100, 60, "SaveAs 3DS File", "Enter filename:", "|FileName|", "|Accept|Cancel|", 111, 79, 220, 177, 197)
aa1% = VAL(RIGHT$(aa1$, 1))
IF (aa1% = 1) THEN
aa1$ = MID$(aa1$, 2, INSTR(2, aa1$, CHR$(0)) - 2)
IF (aa1$ = "") THEN
sof.error "No Filename     ", "Enter a filename"
ELSE
IF (err.filename%(aa2$) <> 0) THEN
sof.error "Invalid Filename", "Enter a correct DOS filename."
GOTO men.saveas3dse
END IF
IF (INSTR(aa1$, ".") = 0) THEN aa1$ = aa1$ + ".3ds"
Filename$ = aa1$
END IF
END IF
IF (Filename$ <> "") THEN
SHELL "copy zzzzzzzz.ini " + Filename$ + " >zzzzzzzy.ini"
KILL "zzzzzzzy.ini"
sof.message "File saved as to " + Filename$
sof.filename
END IF
men.saveas3dse:
RETURN

men.exit:
aa1$ = win.ask$(80, 70, "Confirm Exit", "Are you sure you  have done all ?", "||", "|Exit|Continue|", 111, 50, 207, 127, 176)
IF (RIGHT$(aa1$, 1) = "1") THEN
KILL "zzzzzzzz.ini"
SYSTEM
END IF
RETURN

men.slideselect:
aa1$ = win.ask$(80, 80, "Select Slide    ", "Enter slide number: Current slide=" + STR$(ActiveSlide&), "|Slide|", "|Choose|Cancel|", 111, 10, 207, 27, 196)
aa1% = VAL(RIGHT$(aa1$, 1))
IF (aa1% <> 1) THEN GOTO men.slideselecte
aa2$ = c.word$(aa1$, 1)
IF (aa2$ = "") THEN
sof.error "No Slide     ", "Enter a slide number"
GOTO men.slideselecte
END IF
IF (c.val&(aa2$) <= 0) THEN
sof.error "Slide error", "Out of 3ds slide range."
GOTO men.slideselecte
END IF
ActiveSlide& = c.val&(aa2$)
sof.writeinf
sof.message "Slide " + STR$(ActiveSlide&) + " selected."
GOSUB men.display
men.slideselecte:
RETURN

men.colourengine:
aa1$ = win.ask$(40, 80, "Select RGB Format", "Enter [R][G][B]", "|RGB Style|", "|Select|Cancel|", 111, 10, 230, 107, 99)
aa1% = VAL(RIGHT$(aa1$, 1))
IF (aa1% <> 1) THEN GOTO men.colourenginee
aa2$ = c.word$(aa1$, 1)
IF (LEN(aa2$) <> 3) THEN
sof.error "Incorrect Format", "Example RG0 to get a picture without blue"
GOTO men.colourenginee
END IF
too.colourengine UCASE$(aa2$)
men.colourenginee:
RETURN

men.defaultize:
ActiveSlide& = 1
MaxSlide& = 1
sof.writeinf
Piccentre.x = charcentrex
Piccentre.y = charcentrey
Xrange.x = Piccentre.x - (Resolution.x + 1) \ 2 + (Resolution.x MOD 2)
Xrange.y = Piccentre.x + (Resolution.x + 1) \ 2
Yrange.x = Piccentre.y - (Resolution.y + 1) \ 2 + (Resolution.y MOD 2)
Yrange.y = Piccentre.y + (Resolution.y + 1) \ 2
RETURN

men.slidestate:
aa1$ = "Current Slide:" + STR$(ActiveSlide&) + CHR$(enter) + "Total Slides:" + STR$(MaxSlide&)
win.tell 40, 40, "Slides State   ", aa1$, 180, 120, 219, 84
RETURN

men.slidepaste:
aa1$ = win.ask$(50, 60, "Slide Paste", "Enter slide number to paste:Total slides=" + STR$(MaxSlide&), "|Slide|", "|Choose|Cancel|", 111, 122, 222, 111, 99)
aa1% = VAL(RIGHT$(aa1$, 1))
IF (aa1% <> 1) THEN GOTO men.slidepastee
aa2$ = c.word$(aa1$, 1)
IF (aa2$ = "") THEN
sof.error "No Slide     ", "Enter a slide number"
GOTO men.slidepastee
END IF
IF (c.val&(aa2$) <= 0) THEN
sof.error "Slide error", "Out of 3ds slide range."
GOTO men.slidepastee
END IF
sof.pasteslide "zzzzzzzz.ini", ActiveSlide&, "zzzzzzzz.ini", VAL(aa2$)
ActiveSlide& = c.val&(aa2$)
sof.writeinf
sof.message "Slide pasted to " + STR$(ActiveSlide&) + " ."
GOSUB men.display
men.slidepastee:
RETURN

men.clearslide:
aa1$ = win.ask$(50, 60, "Clear Slide", "Are you sure you want to clear this slide?", "||", "|Sure|No|", 151, 172, 212, 151, 199)
aa1% = VAL(RIGHT$(aa1$, 1))
IF (aa1% = 1) THEN
sof.clearslide
sof.writeinf
sof.message "Slide " + STR$(ActiveSlide&) + " cleared ."
GOSUB men.display
END IF
RETURN


men.errors:
ErrorType% = ERR
RESUME NEXT

SUB asm.loadprog (fl1$, s$)
fr% = FREEFILE
OPEN "B", fr%, fl1$
FOR i& = 1 TO LOF(1)
s$ = s$ + INPUT$(1, #fr%)
NEXT
CLOSE #fr%
END SUB

SUB c.blinkcursor (cl%, size!, delay!)
SHARED Lastcharpoint AS pixel
a1! = size! * .5 * CONST.cspace
cl1% = cl%
FOR lv1% = 1 TO CONST.blinktime2
mouse.hide
IF (lv1% MOD 2 = 0) THEN
cl1% = 0
LINE (Lastcharpoint.x - a1!, Lastcharpoint.y - 5 * size!)-(Lastcharpoint.x + a1!, Lastcharpoint.y + 5 * size!), cl1%, BF
ELSE
cl1% = cl%
LINE (Lastcharpoint.x - a1!, Lastcharpoint.y - 5 * size!)-(Lastcharpoint.x + a1!, Lastcharpoint.y + 5 * size!), cl1%, BF
END IF
mouse.show
c.delay CONST.blinktime1 * delay!
NEXT
END SUB

SUB c.character (char$, xx%, yy%, clr%, size!, ers%)
'check character
a1! = size! * .5 * CONST.cspace
dis% = INT(ASC(char$) - 32)
IF (dis% > 0) THEN
sld% = dis%
fl1$ = "chars.fon"
ELSEIF (ers% = 0) THEN
LINE (xx% - a1!, yy% - 5 * size!)-(xx% + a1!, yy% + 5 * size!), 0, BF
GOTO character1
ELSE
GOTO character1
END IF
'draw character
fr% = FREEFILE
OPEN "B", #fr%, fl1$
SEEK #fr%, 1
read$ = INPUT$(4, #fr%)
xres& = ASC(LEFT$(read$, 1)) * 256 + ASC(MID$(read$, 2, 1))
yres& = ASC(MID$(read$, 3, 1)) * 256 + ASC(RIGHT$(read$, 1))
xx1% = xx% - INT(xres& / 2)
yy1% = yy% - INT(yres& / 2)
pos1& = 7 + ((sld% - 1) * (xres& + 1) * (yres& + 1))
SEEK #fr%, pos1&
read$ = INPUT$((xres& + 1) * (yres& + 1), #fr%)
CLOSE #fr%
DEF SEG = VARSEG(read$)
pos1& = SADD(read$)
FOR j% = yres& TO 0 STEP -1
FOR i% = 0 TO xres&
colour% = PEEK(pos1&)
IF (colour% = 1) THEN colour% = clr% ELSE colour% = 0
IF (colour% <> 0 OR ers% = 0) THEN LINE (xx1% + i% * size! - size! + 1, yy1% + j% * size! - size! + 1)-(xx1% + i% * size! + size! - 1, yy1% + j% * size! + size! - 1), colour%, BF
pos1& = pos1& + 1
NEXT
NEXT
DEF SEG
character1:
END SUB

SUB c.clearkey
DEF SEG = 0               'stop beep sound
POKE &H41A, PEEK(&H41C)   '(by clearing keyboard buffer)
DEF SEG                   '(Qbasic tip)
END SUB

SUB c.delay (seconds!)
times& = 80000 * seconds!
val1% = INP(&H61)       'connect speaker to timer2
val1% = val1% OR 3
OUT &H61, val1%
FOR i% = 1000 TO 6000 STEP 100
freq% = i%
GOSUB delay2
freq% = 6200 - i%
GOSUB delay2
FOR j& = 1 TO times&
NEXT
NEXT
'disconnect speaker from timer2
val1% = INP(&H61)
val1% = val1% AND 252
OUT &H61, val1%
GOTO delay1
delay2:
countdown& = 1193180 \ freq%  'calculate countdown
low& = countdown& MOD 256'send the lowbyte and highbyte of new countdown value
high& = countdown& \ 256
OUT &H43, &HB6    'tell timer2 that we are about to load a new countdown value
OUT &H42, low&
OUT &H42, high&
RETURN
delay1:
END SUB

SUB c.dispstring (s$, xx%, yy%, clr%, o%, e%, size!, ers%)
SHARED Lastcharpoint AS pixel, cursoractive%

IF (s$ = CHR$(0)) THEN
Lastcharpoint.x = 5
Lastcharpoint.y = 5
GOTO c.dispstring1
END IF
a1% = INT(CONST.linegap * size!)
a2% = INT(CONST.cspace * size!)
x1% = xx%
y1% = yy%
FOR i% = 1 TO LEN(s$)
c$ = MID$(s$, i%, 1)
IF (c$ = CHR$(enter)) THEN
        x1% = xx%
        y1% = y1% + a1%
ELSE
        IF (o% <> 0) THEN mouse.hide
        c.character c$, x1%, y1%, clr%, size!, ers%
        IF (o% <> 0) THEN mouse.show
        x1% = x1% + a2%
END IF
IF (x1% >= 315) THEN
        x1% = xx%
        y1% = y1% + a1%
END IF
Lastcharpoint.x = x1%
Lastcharpoint.y = y1%
IF (o% <> 0) THEN c.blinkcursor o%, size!, 1
NEXT
IF (e% <> 0) THEN
y1% = y1% + INT(e% * CONST.linegap * size!)
x1% = xx%
Lastcharpoint.x = x1%
Lastcharpoint.y = y1%
END IF
c.dispstring1:
END SUB

FUNCTION c.fileread$ (fl1$, pos1&, l%)
fr% = FREEFILE
OPEN "B", #fr%, fl1$
SEEK #fr%, pos1&
c.fileread$ = INPUT$(l%, #fr%)
CLOSE #fr%
END FUNCTION

SUB c.filewrite (fl1$, pos1&, s$)
fr% = FREEFILE
OPEN "B", #fr%, fl1$
PUT #fr%, pos1&, s$
CLOSE #fr%
END SUB

FUNCTION c.input$ (s$, cl%, leng%)
SHARED Lastcharpoint AS pixel

xg% = CONST.linegap \ 2
yg% = CONST.cspace \ 2
'VIEW SCREEN (textslimitx1, textslimity1)-(textslimitx2, textslimity2)
cl1% = (cl% + 1) MOD 256
cl2% = (cl% + 2) MOD 256
cl3% = (cl% + 3) MOD 256
c.dispstring s$, CINT(Lastcharpoint.x), CINT(Lastcharpoint.y), cl%, cl1%, 0, 1, 1
LINE (Lastcharpoint.x - .5 * CONST.cspace, Lastcharpoint.y - 5)-(Lastcharpoint.x - .5 * CONST.cspace + leng% * CONST.cspace, Lastcharpoint.y + 5), 0, BF

x1% = Lastcharpoint.x
y1% = Lastcharpoint.y
ln% = 0
st$ = ""
k$ = ""
DO UNTIL k$ = CHR$(enter)
        k$ = ""
        c.clearkey      'clear keyboard buffer
        WHILE k$ = ""
        k$ = INKEY$
        'mouse usage
        'mouse.status
        WEND
        k% = ASC(k$)
SELECT CASE k%
CASE esc
        Lastcharpoint.x = x1%
        Lastcharpoint.y = y1%
        st$ = ""
        c.dispstring SPACE$(ln%), CINT(Lastcharpoint.x), CINT(Lastcharpoint.y), cl%, 0, 0, 1, 0
        Lastcharpoint.x = x1%
        Lastcharpoint.y = y1%
        c.blinkcursor cl3%, 1, 2
        ln% = 0
CASE backspc
        ln% = ln% - 1
        IF (ln% >= 0) THEN
        Lastcharpoint.x = Lastcharpoint.x - CONST.cspace
        IF (Lastcharpoint.x < charlimitx1) THEN
        Lastcharpoint.x = charlimitx2
        Lastcharpoint.y = Lastcharpoint.y - CONST.linegap
        END IF
        a1% = Lastcharpoint.x
        a2% = Lastcharpoint.y
        c.dispstring " ", CINT(Lastcharpoint.x), CINT(Lastcharpoint.y), cl%, 0, 0, 1, 0
        st$ = LEFT$(st$, LEN(st$) - 1)
        Lastcharpoint.x = a1%
        Lastcharpoint.y = a2%
        c.blinkcursor cl1%, 1, 1
        ELSE
        c.blinkcursor cl3%, 1, 1
        ln% = ln% + 1
        END IF
CASE IS > 31 AND k% < 127       'some character
        IF (Lastcharpoint.x < charlimitx2) THEN
        ln% = ln% + 1
        IF (ln% > leng%) THEN
        ln% = ln% - 1
        c.blinkcursor cl3%, 1, 1
        ELSE
        c.dispstring k$, CINT(Lastcharpoint.x), CINT(Lastcharpoint.y), cl2%, cl1%, 0, 1, 1
        st$ = st$ + k$
        END IF
        ELSE
        c.blinkcursor cl3%, 1, 1
        END IF
CASE ELSE
END SELECT
LOOP
Lastcharpoint.x = textlimitx1
Lastcharpoint.y = Lastcharpoint.y + CONST.linegap
IF (Lastcharpoint.y > charlimity2) THEN Lastcharpoint.y = textlimity1
'VIEW
c.input$ = st$
END FUNCTION

FUNCTION c.stringcount% (s$, c$)
a1% = LEN(c$)
FOR i% = 1 TO (LEN(s$) - a1% + 1)
a1$ = MID$(s$, i%, a1%)
IF (a1$ = c$) THEN a2% = a2% + 1
NEXT
c.stringcount% = a2%
END FUNCTION

FUNCTION c.val& (s$)
IF (VAL(s$) < 65536 AND VAL(s$) >= 0) THEN c.val& = VAL(s$)
END FUNCTION

FUNCTION c.word$ (s$, no%)
SHARED CONST.separators AS STRING
a1% = 0
a3% = 1
FOR i% = 1 TO LEN(s$)
a1$ = MID$(s$, i%, 1)
IF (INSTR(CONST.separators, a1$)) THEN
        a1% = a1% + 1
        a2% = a3%
        a3% = i%
        END IF
IF (a1% > no%) THEN EXIT FOR
NEXT
IF (a1% <= no%) THEN
ret$ = ""
ELSE
a4% = a3% - a2% - 1
IF (a4% > 0) THEN ret$ = MID$(s$, a2% + 1, a4%)
END IF
c.word$ = ret$
END FUNCTION

FUNCTION err.bmpresolution% (fl1$, xres&, yres&)
fr% = FREEFILE
OPEN "B", #fr%, fl1$
SEEK #fr%, 19
read$ = INPUT$(8, #fr%)
CLOSE #fr%
FOR i& = 0 TO 3          'Xsize,Ysize
xsize& = xsize& + ASC(MID$(read$, i& + 1, 1)) * 256 ^ i&
ysize& = ysize& + ASC(MID$(read$, i& + 5, 1)) * 256 ^ i&
NEXT
IF (xsize& <> xres& + 1 OR ysize& <> yres& + 1) THEN a1% = 1
err.bmpresolution% = a1%
END FUNCTION

FUNCTION err.filename% (fl1$)
SHARED ErrorType%
fr% = FREEFILE
OPEN "B", #fr%, fl1$
CLOSE #fr%
IF (ErrorType% = 0) THEN KILL fl1$
err.filename% = ErrorType%
ErrorType% = 0
END FUNCTION

FUNCTION err.filepresent% (fl1$)
SHARED ErrorType%
fr% = FREEFILE
OPEN "I", #fr%, fl1$
CLOSE #fr%
err.filepresent% = ErrorType%
ErrorType% = 0
END FUNCTION

FUNCTION err.resolution% (fl1$, xres&, yres&)
fr% = FREEFILE
OPEN "B", #fr%, fl1$
SEEK #fr%, 1
k$ = INPUT$(4, #fr%)
CLOSE #fr%
xres1& = ASC(LEFT$(k$, 1)) + ASC(MID$(k$, 2, 1)) * 256
yres1& = ASC(MID$(k$, 3, 1)) + ASC(RIGHT$(k$, 1)) * 256
IF (xres& <> xres1& OR yres& <> yres1&) THEN a1% = 1
err.resolution% = a1%
END FUNCTION

FUNCTION err.slidenumber% (s1$)
a1$ = LTRIM$(RTRIM$(s1$))
IF (a1$ = "0") THEN a3% = 1
FOR i% = 1 TO LEN(a1$)
a2% = ASC(MID$(a1$, i%, 1))
IF (a2% < 48 OR a2% > 57) THEN a3% = 1
NEXT
err.slidenumber% = a3%
END FUNCTION

FUNCTION err.slidepresent% (fl1$, s1%)
fr% = FREEFILE
OPEN "B", #fr%, fl1$
SEEK #fr%, 5
k$ = INPUT$(2, #fr%)
a1% = ASC(LEFT$(k$, 1)) + ASC(RIGHT$(k$, 1)) * 256
IF (s1% > a1%) THEN a2% = 1
CLOSE #fr%
err.slidepresent% = a2%
END FUNCTION

SUB grp.default
SHARED Engine$
DEF SEG = VARSEG(Engine$)
CALL absolute(SADD(Engine$) + 147)
DEF SEG
END SUB

SUB grp.notbox (x1%, y1%, x2%, y2%)
DEF SEG = &HA000
FOR yy& = y1% TO y2%
mem1& = 320 * yy&
FOR xx& = x1% TO x2%
mem2& = mem1& + xx&
POKE mem2&, NOT (PEEK(mem2&)) AND &HFF
NEXT
NEXT
DEF SEG
END SUB

SUB grp.xorbox (x1%, y1%, x2%, y2%, clr%)
SHARED Engine$
DEF SEG = VARSEG(Engine$)
CALL absolute(BYVAL x1%, BYVAL y1%, BYVAL x2%, BYVAL y2%, BYVAL clr%, SADD(Engine$) + 271)
DEF SEG
END SUB

SUB mouse.hide
SHARED Engine$
CALL absolute(SADD(Engine$) + 26)
END SUB

FUNCTION mouse.init%
SHARED Engine$
a1% = 0
CALL absolute(BYVAL VARSEG(a1%), BYVAL VARPTR(a1%), SADD(Engine$))
mouse.init% = a1%
END FUNCTION

SUB mouse.put (x%, y%)
SHARED Engine$
CALL absolute(BYVAL x% * 2, BYVAL y%, SADD(Engine$) + 61)
END SUB

SUB mouse.relativestatus
SHARED Engine$, Jerry AS mouse
DIM Temp%(3)
CALL absolute(BYVAL VARSEG(Temp%(0)), BYVAL VARPTR(Temp%(0)), SADD(Engine$) + 110)
Jerry.x = Temp%(1)
Jerry.y = Temp%(2)
Jerry.lb = Temp%(0)
Jerry.rb = Temp%(0)
END SUB

SUB mouse.setrange (x1%, y1%, x2%, y2%)
SHARED Engine$
CALL absolute(BYVAL x1%, BYVAL y1%, BYVAL x2%, BYVAL y2%, SADD(Engine$) + 32)
END SUB

SUB mouse.show
SHARED Engine$
CALL absolute(SADD(Engine$) + 20)
END SUB

SUB mouse.status
SHARED Engine$, Jerry AS mouse
DIM Temp%(3)
CALL absolute(BYVAL VARSEG(Temp%(0)), BYVAL VARPTR(Temp%(0)), SADD(Engine$) + 79)
Jerry.clk = 0
Jerry.x = Temp%(1) \ 2
Jerry.y = Temp%(2)
Jerry.lb = Temp%(0) AND 1
Jerry.rb = (Temp%(0) AND 2) \ 2
IF (Jerry.cs = 1 AND Jerry.lb = 0) THEN Jerry.clk = 1
Jerry.cs = Jerry.lb
END SUB

FUNCTION nospc$ (a$)
FOR i% = 1 TO LEN(a$)
B$ = MID$(a$, i%, 1)
IF (B$ <> " ") THEN c$ = c$ + B$
NEXT
nospc$ = c$
END FUNCTION

SUB snd.click
FOR i% = 1000 TO 6000 STEP 500
SOUND i%, .05
SOUND 5000 + (i% \ 100), .05
SOUND i% + 6000, .05
NEXT
END SUB

SUB sof.clearslide
SHARED ActiveSlide&, Resolution AS pixel
pos1& = 7 + (Resolution.x + 1) * (Resolution.y + 1) * (ActiveSlide& - 1)
a1$ = STRING$(Resolution.x + 1, 0)
fr% = FREEFILE
OPEN "B", #fr%, "zzzzzzzz.ini"
FOR i% = 0 TO Resolution.y
PUT #fr%, pos1&, a1$
pos1& = pos1& + Resolution.x + 1
NEXT
CLOSE #fr%
END SUB

SUB sof.display (fl1$, x&, y&, sld&)
SHARED Piccentre AS pixel, Resolution AS pixel, Xrange AS pixel, Yrange AS pixel, Engine$, Zone%()
mouse.hide
VIEW SCREEN (charlimitx1, charlimity1)-(charlimitx2, charlimity2)
'CLS
read$ = fl1$ + CHR$(0)
CALL absolute(BYVAL CINT(x&), BYVAL CINT(y&), BYVAL CINT(sld&), BYVAL charlimitx1, BYVAL charlimity1, BYVAL charlimitx2, BYVAL charlimity2, BYVAL VARSEG(Zone%(0)), BYVAL VARPTR(Zone%(0)), BYVAL VARSEG(read$), BYVAL SADD(read$), SADD(Engine$) + 337)
Xrange.x = x& - (Resolution.x + 1) \ 2 - 1
Xrange.y = Xrange.x + Resolution.x + 2
Yrange.x = y& - (Resolution.y + 1) \ 2 - 1
Yrange.y = Yrange.x + Resolution.y + 2
LINE (Xrange.x, Yrange.x)-(Xrange.y, Yrange.y), 255, B
VIEW
mouse.show
END SUB

SUB sof.error (s1$, s2$)
sof.message "Error Report..."
win.tell 40, 40, s1$, s2$, 180, 120, 219, 84
END SUB

SUB sof.filename
SHARED Filename$
a1$ = Filename$
IF (a1$ = "") THEN a1$ = "Untitled"
LINE (110, 13)-(190, 22), 124, BF
c.dispstring a1$, 115, 17, 12, 0, 0, 1, 1
END SUB

SUB sof.message (s$)
mouse.hide
LINE (charlimitx1, charlimity2 + 3)-(charlimitx2, charlimity2 + 13), 1, BF
c.dispstring s$, charlimitx1 + 5, charlimity2 + 8, 192, 0, 0, 1, 1
mouse.show
END SUB

SUB sof.pasteslide (fl1$, s1&, fl2$, s2&)
SHARED Resolution AS pixel

fr% = FREEFILE
OPEN "B", #fr%, fl1$
SEEK #fr%, 1
read$ = INPUT$(4, #fr%)
xres& = (ASC(LEFT$(read$, 1)) + ASC(MID$(read$, 2, 1)) * 256) + 1
yres& = (ASC(MID$(read$, 3, 1)) + ASC(RIGHT$(read$, 1)) * 256) + 1
Resolution.x = xres& - 1
Resolution.y = yres& - 1
fr2% = FREEFILE
OPEN "B", #fr2%, fl2$
sof.writeinf
pos1& = 7 + ((s1& - 1) * xres& * yres&)
pos2& = 7 + ((s2& - 1) * xres& * yres&)
FOR i& = 1 TO yres&
SEEK #fr%, pos1&
k$ = INPUT$(xres&, #fr%)
PUT #fr2%, pos2&, k$
pos1& = pos1& + xres&
pos2& = pos2& + xres&
NEXT
CLOSE #fr%, fr2%
END SUB

SUB sof.resolution
SHARED Resolution AS pixel
a3$ = RTRIM$(LTRIM$(STR$(Resolution.x + 1)))
a3$ = STRING$(5 - LEN(a3$), "0") + a3$
a4$ = RTRIM$(LTRIM$(STR$(Resolution.y + 1)))
a4$ = STRING$(5 - LEN(a4$), "0") + a4$
mouse.hide
LINE (220, 182)-(255, 191), 188, BF
LINE (260, 182)-(295, 191), 178, BF
c.dispstring a3$, 225, 186, 2, 0, 0, 1, 1
c.dispstring a4$, 265, 186, 2, 0, 0, 1, 1
mouse.show
END SUB

SUB sof.saveram (fl1$)
SHARED onechar AS STRING * 1, bmp AS STRING * 3, ActiveSlide&, MaxSlide&, Resolution AS pixel, Xrange AS pixel, Yrange AS pixel, Piccentre AS pixel
sof.message "Loading ..."
fr% = FREEFILE
OPEN "B", #fr%, fl1$
fr2% = FREEFILE
OPEN "B", #fr2%, "zzzzzzzz.ini"
length& = LOF(fr%)
SEEK #fr%, 19
read$ = INPUT$(8, #fr%)
FOR i& = 0 TO 3          'Xsize,Ysize
xsize& = xsize& + ASC(MID$(read$, i& + 1, 1)) * 256 ^ i&
ysize& = ysize& + ASC(MID$(read$, i& + 5, 1)) * 256 ^ i&
NEXT
a1& = xsize& - 1
Resolution.x = a1&
a1$ = CHR$(a1& MOD 256) + CHR$(a1& \ 256)
PUT #fr2%, 1, a1$
a1& = ysize& - 1
Resolution.y = a1&
Xrange.x = Piccentre.x - xsize& \ 2 + (Resolution.x MOD 2)
Xrange.y = Piccentre.x + xsize& \ 2
Yrange.x = Piccentre.y - ysize& \ 2 + (Resolution.y MOD 2)
Yrange.y = Piccentre.y + ysize& \ 2
a1$ = CHR$(a1& MOD 256) + CHR$(a1& \ 256) + CHR$(MaxSlide& MOD 256) + CHR$(MaxSlide& \ 256)
PUT #fr2%, 3, a1$
pos1& = 7 + (xsize& * ysize&) * CLNG(ActiveSlide&)
linebytes& = (length& - 54) / ysize& - 3 * xsize&
readsize& = xsize& * 3

SEEK #fr%, 55
FOR y% = ysize& - 1 TO 0 STEP -1
pos1& = pos1& - xsize&
read$ = INPUT$(readsize&, #fr%)
write$ = ""
pos2& = 1
FOR x% = 1 TO xsize&
B% = ASC(MID$(read$, pos2&, 1))
g% = ASC(MID$(read$, pos2& + 1, 1))
r% = ASC(MID$(read$, pos2& + 2, 1))
pos2& = pos2& + 3
write$ = write$ + CHR$((r% AND &HC0) + (g% AND &HE0) \ 4 + (B% AND &HE0) \ 32)
NEXT
PUT #fr2%, pos1&, write$
SEEK #fr%, SEEK(fr%) + linebytes&
NEXT
CLOSE #fr%, #fr2%
sof.message "Loaded."
END SUB

SUB sof.slidenumber
SHARED ActiveSlide&, MaxSlide&
a1$ = RTRIM$(LTRIM$(STR$(ActiveSlide&)))
a1$ = STRING$(5 - LEN(a1$), "0") + a1$
a2$ = RTRIM$(LTRIM$(STR$(MaxSlide&)))
a2$ = STRING$(5 - LEN(a2$), "0") + a2$
mouse.hide
LINE (240, 1)-(275, 10), 188, BF
LINE (280, 1)-(315, 10), 178, BF
c.dispstring a1$, 245, 5, 2, 0, 0, 1, 1
c.dispstring a2$, 285, 5, 2, 0, 0, 1, 1
mouse.show
END SUB

SUB sof.write (fl1$, x%, y%, sld&, clr&)
SHARED Resolution AS pixel
IF (x% >= 0 AND x% <= Resolution.x AND y% >= 0 AND y% <= Resolution.y) THEN
pos1& = 7 + ((sld& - 1) * (Resolution.x + 1) * (Resolution.y + 1))
pos1& = pos1& + (Resolution.x + 1) * CLNG(y%) + CLNG(x%)
a1$ = CHR$(clr&)
fr% = FREEFILE
OPEN "B", #fr%, fl1$
PUT #fr%, pos1&, a1$
CLOSE #fr%
END IF
END SUB

SUB sof.writeinf
SHARED Resolution AS pixel, ActiveSlide&, MaxSlide&
IF (ActiveSlide& > MaxSlide&) THEN MaxSlide& = ActiveSlide&
fr% = FREEFILE
OPEN "B", #fr%, "zzzzzzzz.ini"
a1$ = CHR$(Resolution.x MOD 256) + CHR$(Resolution.x \ 256) + CHR$(Resolution.y MOD 256) + CHR$(Resolution.y \ 256) + CHR$(MaxSlide& MOD 256) + CHR$(MaxSlide& \ 256)
PUT #fr%, 1, a1$
a1$ = CHR$(0)
a1& = 8 + MaxSlide& * (Resolution.x + 1) * (Resolution.y + 1)
PUT #fr%, a1&, a1$
CLOSE #fr%
sof.slidenumber
END SUB

SUB too.brush
SHARED Piccentre AS pixel, Resolution AS pixel, Pointer AS pixel, Jerry AS mouse
SHARED ActiveSlide&
ax% = (Resolution.x + 1) \ 2 + Jerry.x - Piccentre.x
ay% = (Resolution.y + 1) \ 2 + Jerry.y - Piccentre.y
a1% = -1
mouse.hide
VIEW SCREEN (charlimitx1, charlimity1)-(charlimitx2, charlimity2)
FOR i% = ax% - 1 TO ax% + 1
a2% = -1
FOR j% = ay% - 1 TO ay% + 1
IF (i% >= 0 AND i% <= Resolution.x AND j% >= 0 AND j% <= Resolution.y) THEN
sof.write "zzzzzzzz.ini", i%, j%, ActiveSlide&, Pointer.y
LINE (Jerry.x + a1%, Jerry.y + a2%)-(Jerry.x + a1%, Jerry.y + a2%), Pointer.y
END IF
a2% = a2% + 1
NEXT
a1% = a1% + 1
NEXT
VIEW
mouse.show
END SUB

SUB too.colourengine (c$)
SHARED ActiveSlide&, Piccentre AS pixel
DIM changes%(255)

FOR i% = 0 TO 255
c% = i%
r% = c% \ 64
a1% = r% * 2 + ((r% AND 1) AND ((r% AND 2) \ 2))
c% = c% - (64 * r%)
r% = a1%
g% = c% \ 8
c% = c% - (8 * g%)
B% = c%

cr$ = LEFT$(c$, 1)
        SELECT CASE cr$
        CASE "R"
        r1% = r%
        CASE "G"
        r1% = g%
        CASE "B"
        r1% = B%
        CASE ELSE
        r1% = 0
        END SELECT
cr$ = MID$(c$, 2, 1)
        SELECT CASE cr$
        CASE "R"
        g1% = r%
        CASE "G"
        g1% = g%
        CASE "B"
        g1% = B%
        CASE ELSE
        g1% = 0
        END SELECT
cr$ = RIGHT$(c$, 1)
        SELECT CASE cr$
        CASE "R"
        b1% = r%
        CASE "G"
        b1% = g%
        CASE "B"
        b1% = B%
        CASE ELSE
        b1% = 0
        END SELECT
c1% = (r1% \ 2) * 64 + g1% * 8 + b1%
changes%(i%) = c1%
NEXT
fr% = FREEFILE
OPEN "B", #fr%, "zzzzzzzz.ini"
SEEK #fr%, 1
read$ = INPUT$(2, #fr%)
xres& = ASC(LEFT$(read$, 1)) + ASC(RIGHT$(read$, 1)) * 256
read$ = INPUT$(2, #fr%)
yres& = ASC(LEFT$(read$, 1)) + ASC(RIGHT$(read$, 1)) * 256
read$ = INPUT$(2, #fr%)
pos1& = 7 + ((ActiveSlide& - 1) * (xres& + 1) * (yres& + 1))
FOR j% = 0 TO yres&
FOR i% = 0 TO xres&
SEEK #fr%, pos1&
a1$ = CHR$(changes%(ASC(INPUT$(1, #fr%) + CHR$(0))))
PUT #fr%, pos1&, a1$
pos1& = pos1& + 1
NEXT
NEXT
CLOSE #fr%
sof.display "zzzzzzzz.ini", Piccentre.x, Piccentre.y, ActiveSlide&
END SUB

SUB too.eraser
SHARED Pointer AS pixel
SWAP a1&, Pointer.y
too.brush
Pointer.y = a1&
END SUB

SUB too.pencil
SHARED Piccentre AS pixel, Resolution AS pixel, Pointer AS pixel, Jerry AS mouse
SHARED ActiveSlide&
ax% = (Resolution.x + 1) \ 2 + Jerry.x - Piccentre.x
ay% = (Resolution.y + 1) \ 2 + Jerry.y - Piccentre.y
mouse.hide
VIEW SCREEN (charlimitx1, charlimity1)-(charlimitx2, charlimity2)
IF (ax% >= 0 AND ax% <= Resolution.x AND ay% >= 0 AND ay% <= Resolution.y) THEN
sof.write "zzzzzzzz.ini", ax%, ay%, ActiveSlide&, Pointer.y
PSET (Jerry.x, Jerry.y), Pointer.y
END IF
VIEW
mouse.show
END SUB

FUNCTION win.ask$ (x%, y%, name$, tell$, boxes$, buttons$, clr1%, clr2%, clr3%, clr4%, clr5%)
SHARED Jerry AS mouse, Lastcharpoint AS pixel
a1% = -1
FOR i% = 1 TO LEN(boxes$)
a1$ = MID$(boxes$, i%, 1)
IF (a1$ = "|") THEN a1% = a1% + 1
NEXT
x1% = x% + LEN(name$) * 10
y1% = y% + (LEN(tell$) \ LEN(name$)) * 10 + 22 * a1% + 50
mouse.hide
DIM Area%(20000)
GET (x%, y%)-(x1%, y1%), Area%
LINE (x%, y%)-(x1%, y1%), clr2%, BF
LINE (x% + 1, y% + 1)-(x1% - 1, y% + 14), clr1%, BF
c.dispstring name$, x% + 6, y% + 6, clr3%, 0, 0, 1.3, 1
a2$ = tell$
x2% = x% + 6
y2% = y% + 20
a3% = INT(LEN(name$) * 1.5)
DO
IF (LEN(a2$) > a3%) THEN a1$ = LEFT$(a2$, a3%) ELSE a1$ = a2$
c.dispstring a1$, x2%, y2%, clr4%, 0, 0, 1, 1
IF (a1$ = a2$) THEN EXIT DO
a2$ = RIGHT$(a2$, LEN(a2$) - a3%)
y2% = y2% + 10
LOOP
y2% = y2% + 10
a1% = -1
FOR i% = 1 TO LEN(boxes$)
a1$ = MID$(boxes$, i%, 1)
IF (a1$ = "|") THEN a1% = a1% + 1
NEXT
DIM boxx1%(a1% - 1), boxy1%(a1% - 1), boxx2%(a1% - 1), boxy2%(a1% - 1), boxx$(a1% - 1)
a2% = 1
cll% = (clr1% + 20) MOD 256
FOR i% = 0 TO a1% - 1
a2% = INSTR(a2%, boxes$, "|") + 1
a3% = INSTR(a2%, boxes$, "|") - a2%
c.dispstring MID$(boxes$, a2%, a3%), x2%, y2% + 5, clr5%, 0, 0, .9, 1
y2% = y2% + 10
LINE (x2%, y2%)-(x1% - 6, y2% + 12), cll%, B
LINE (x2% + 1, y2% + 1)-(x1% - 7, y2% + 11), 0, BF
boxx1%(i%) = x2% + 1
boxy1%(i%) = y2% + 1
boxx2%(i%) = x1% - 7
boxy2%(i%) = y2% + 11
y2% = y2% + 12
NEXT
a1% = -1
FOR i% = 1 TO LEN(buttons$)
a1$ = MID$(buttons$, i%, 1)
IF (a1$ = "|") THEN a1% = a1% + 1
NEXT
DIM btnx1%(a1% - 1), btny1%(a1% - 1), btnx2%(a1% - 1), btny2%(a1% - 1)
a2% = 1
a4% = (x1% - x2% - 3) \ a1%
cll% = (clr4% + 1) MOD 256
y2% = y2% + 5
FOR i% = 0 TO a1% - 1
a2% = INSTR(a2%, buttons$, "|") + 1
a3% = INSTR(a2%, buttons$, "|") - a2%
LINE (x2%, y2%)-(x2% + a4%, y2% + 10), cll%, B
btnx1%(i%) = x2% + 1
btny1%(i%) = y2% + 1
btnx2%(i%) = x2% + a4% - 1
btny2%(i%) = y2% + 9
c.dispstring MID$(buttons$, a2%, a3%), x2% + 5, y2% + 5, clr5%, 0, 0, .9, 1
x2% = x2% + a4%
NEXT
mouse.show
'Loop for input
a1% = 0
a2% = 0
yy& = y%
DO
mouse.status
FOR i% = 0 TO UBOUND(boxx1%)
        IF (Jerry.x >= boxx1%(i%) AND Jerry.x <= boxx2%(i%) AND Jerry.y >= boxy1%(i%) AND Jerry.y <= boxy2%(i%) AND Jerry.clk = 1) THEN
        boxedit% = i% + 1
        EXIT FOR
        END IF
NEXT
FOR i% = 0 TO UBOUND(btnx1%)
        IF (Jerry.x >= btnx1%(i%) AND Jerry.x <= btnx2%(i%) AND Jerry.y >= btny1%(i%) AND Jerry.y <= btny2%(i%) AND Jerry.clk = 1) THEN
        btnedit% = i% + 1
        EXIT FOR
        END IF
NEXT
IF (boxedit% <> 0) THEN
        mouse.hide
        boxedit% = boxedit% - 1
        Lastcharpoint.x = boxx1%(boxedit%) + 5
        Lastcharpoint.y = ((boxy1%(boxedit%) + boxy2%(boxedit%)) \ 2)
        ax% = ((boxx2%(boxedit%) - boxx1%(boxedit%)) \ CONST.cspace) - 1
        boxx$(boxedit%) = c.input$("", clr5%, ax%)
        mouse.show
        boxedit% = 0
END IF
IF (btnedit% <> 0) THEN
        mouse.hide
        btnedit% = btnedit% - 1
        grp.xorbox btnx1%(btnedit%), btny1%(btnedit%), btnx2%(btnedit%), btny2%(btnedit%), clr5%
        snd.click
        button% = btnedit% + 1
        btnedit% = 0
        EXIT DO
END IF
a1% = a1% + 1
IF (a1% = 5000) THEN
        mouse.hide
        a1% = 0
        FOR i% = 0 TO UBOUND(btnx1%)
        grp.xorbox btnx1%(i%), btny1%(i%), btnx2%(i%), btny2%(i%), btnclr%
        NEXT
        btnclr% = (btnclr% + 1) MOD 256
        mouse.show
END IF
IF (INKEY$ = CHR$(esc)) THEN
snd.click
mouse.hide
EXIT DO
END IF
LOOP
ret$ = CHR$(0)
FOR i% = 0 TO UBOUND(boxx1%)
ret$ = ret$ + boxx$(i%) + CHR$(0)
NEXT
ret$ = ret$ + LTRIM$(RTRIM$(STR$(button%)))
LINE (x%, y%)-(x1%, y1%), 0, BF
PUT (x%, y%), Area%
mouse.show
win.ask$ = ret$
END FUNCTION

SUB win.colour
SHARED Pointer AS pixel, Jerry AS mouse, ActiveSlide&, MaxSlide&, Piccentre AS pixel
IF (Jerry.x > 1 AND Jerry.x < 18 AND Jerry.y > 119 AND Jerry.y < 136 AND Jerry.lb = 1) THEN
mouse.hide
Pointer.y = POINT(Jerry.x, Jerry.y)
LINE (2, 138)-(17, 146), Pointer.y, BF
mouse.show
ELSEIF (Jerry.x > 218 AND Jerry.x < 224 AND Jerry.y > 1 AND Jerry.y < 9 AND Jerry.clk = 1) THEN
ActiveSlide& = ActiveSlide& + 1
IF (ActiveSlide& > MaxSlide&) THEN ActiveSlide& = 1
sof.writeinf
sof.display "zzzzzzzz.ini", Piccentre.x, Piccentre.y, ActiveSlide&
ELSEIF (Jerry.x > 206 AND Jerry.x < 212 AND Jerry.y > 1 AND Jerry.y < 9 AND Jerry.clk = 1) THEN
ActiveSlide& = ActiveSlide& - 1
IF (ActiveSlide& < 1) THEN ActiveSlide& = MaxSlide&
sof.writeinf
sof.display "zzzzzzzz.ini", Piccentre.x, Piccentre.y, ActiveSlide&
ELSEIF (Jerry.x > 228 AND Jerry.x < 235 AND Jerry.y > 1 AND Jerry.y < 9 AND Jerry.clk = 1) THEN
ActiveSlide& = ActiveSlide& + 1
sof.writeinf
sof.display "zzzzzzzz.ini", Piccentre.x, Piccentre.y, ActiveSlide&
END IF
END SUB

SUB win.colours
clr% = 0
FOR j% = 30 TO 110
FOR i% = 2 TO 17
LINE (i%, j%)-(i%, j%), clr% \ 100
clr% = clr% + 1
NEXT
NEXT
clr% = 0
FOR j% = 120 TO 135
FOR i% = 2 TO 17
LINE (i%, j%)-(i%, j%), clr%
clr% = clr% + 1
NEXT
NEXT
LINE (1, 119)-(18, 136), 12, B
LINE (1, 137)-(18, 147), 12, B
LINE (charlimitx1 - 1, charlimity2 + 2)-(charlimitx2 + 1, charlimity2 + 14), 12, B
LINE (charlimitx1, charlimity2 + 3)-(charlimitx2, charlimity2 + 13), 1, BF
LINE (210, 3)-(210, 7), 140
LINE (209, 4)-(209, 6), 150
PSET (208, 5), 160
LINE (220, 3)-(220, 7), 140
LINE (221, 4)-(221, 6), 150
PSET (222, 5), 160
LINE (230, 3)-(231, 7), 240, B
LINE (232, 4)-(232, 6), 250
PSET (233, 5), 255

CIRCLE (190, 5), 3, 255
PAINT (190, 5), 245, 255

CIRCLE (10, 40), 3, 120
PAINT (10, 40), 125, 120
LINE (8, 40)-(10, 42), 130
LINE -(13, 37), 140

CIRCLE (10, 50), 3, 170
PAINT (10, 50), 175, 170
LINE (8, 50)-(10, 52), 180
LINE -(13, 48), 190
LINE -(11, 50), 190
LINE (6, 68)-(14, 72), 255, B
END SUB

SUB win.menu
SHARED Jharka$(), Jharkas%(), Lastcharpoint AS pixel, Jerry AS mouse
SHARED MenuTask AS pixel
IF NOT (Jerry.clk = 1 AND Jerry.y < 12) THEN GOTO menu1
FOR i% = 0 TO UBOUND(Jharkas%, 1)
IF (Jerry.x >= Jharkas%(i%, 0) AND Jerry.x <= Jharkas%(i%, 1)) THEN
        winedit% = i% + 1
        EXIT FOR
END IF
NEXT
IF (winedit% = 0) THEN GOTO menu1
mouse.hide
a1% = winedit% - 1
MenuTask.x = winedit%
grp.notbox Jharkas%(a1%, 0), 0, Jharkas%(a1%, 1), 11
snd.click
FOR i% = 1 TO UBOUND(Jharka$, 2)
IF (LEN(Jharka$(a1%, i%)) > a2%) THEN a2% = LEN(Jharka$(a1%, i%))
IF (Jharka$(a1%, i%) <> "") THEN a3% = a3% + 1
NEXT
xx1% = Jharkas%(a1%, 0)
xx2% = Jharkas%(a1%, 0) + (a2% * 6) + 10
yy1% = 12
yy2% = 17 + (a3% * 10)
DIM Area%(5000)
GET (xx1%, yy1%)-(xx2%, yy2%), Area%
LINE (xx1%, yy1%)-(xx2%, yy2%), 255, BF
x1% = Jharkas%(a1%, 0) + 5
y1% = 16
a4% = a3% - 1
DIM menuy1%(a4%), menuy2%(a4%)
FOR i% = 1 TO a3%
menuy1%(i% - 1) = y1% - 4
menuy2%(i% - 1) = y1% + 5
c.dispstring Jharka$(a1%, i%), x1%, y1%, 14, 0, 0, 1!, 1
y1% = y1% + 10
NEXT
mouse.show
DO
mouse.status
IF (Jerry.x > xx1% AND Jerry.x < xx2% AND Jerry.clk = 1) THEN
FOR i% = 0 TO UBOUND(menuy1%)
IF (Jerry.y >= menuy1%(i%) AND Jerry.y <= menuy2%(i%)) THEN
boxedit% = i% + 1
EXIT FOR
END IF
NEXT
END IF
IF (boxedit% <> 0) THEN
MenuTask.y = boxedit%
mouse.hide
a4% = boxedit% - 1
grp.xorbox xx1%, menuy1%(a4%), xx2%, menuy2%(a4%), 134
menu2:
snd.click
LINE (xx1%, yy1%)-(xx2%, yy2%), 0, BF
grp.notbox Jharkas%(a1%, 0), 0, Jharkas%(a1%, 1), 11
boxedit% = 0
mouse.show
EXIT DO
END IF
IF ((Jerry.x >= Jharkas%(a1%, 0) AND Jerry.x <= Jharkas%(a1%, 1) AND Jerry.y < 12 AND Jerry.clk = 1) OR INKEY$ = CHR$(esc)) THEN
MenuTask.x = 0
mouse.hide
GOTO menu2
END IF
a5% = a5% + 1
IF (a5% = 10000) THEN
mouse.hide
a5% = 0
LINE (xx1%, yy1%)-(xx2%, yy2%), a6%, B
a6% = (a6% + 1) MOD 256
mouse.show
END IF
LOOP
mouse.hide
PUT (xx1%, yy1%), Area%
mouse.show
menu1:
END SUB

SUB win.menus
SHARED Jharka$(), Jharkas%(), Lastcharpoint AS pixel
Lastcharpoint.x = 5
Lastcharpoint.y = 5
LINE (0, 0)-(319, 11), 12, BF
LINE (0, 0)-(300, 0), 117
LINE (0, 1)-(200, 1), 116
LINE (0, 2)-(100, 2), 115
LINE (0, 3)-(50, 3), 114
LINE (0, 4)-(30, 4), 113
LINE (0, 5)-(20, 5), 112
LINE (0, 6)-(12, 6), 111
LINE (0, 7)-(10, 7), 110
LINE (0, 8)-(3, 8), 19
LINE (0, 9)-(2, 9), 18
LINE (0, 10)-(0, 10), 17
FOR i% = 0 TO UBOUND(Jharka$, 1)
Jharkas%(i%, 0) = Lastcharpoint.x - 5
c.dispstring Jharka$(i%, 0), CINT(Lastcharpoint.x), CINT(Lastcharpoint.y), 255, 0, 0, 1, 1
Jharkas%(i%, 1) = Lastcharpoint.x - 5
NEXT
END SUB

SUB win.scroll
SHARED ScrollBar() AS SINGLE, Jerry AS mouse, Piccentre AS pixel, Resolution AS pixel, ActiveSlide&, Refresh%
IF ((Jerry.x > 310 OR Jerry.y > 190) AND (Jerry.lb = 1 OR Jerry.rb = 1)) THEN
IF (Jerry.rb = 1) THEN rat% = 1 ELSE rat% = 2
IF (Jerry.lb = 1 AND Jerry.rb = 1) THEN rat% = 5
IF (rat% <> Refresh%) THEN
win.scrollrefresh
Refresh% = rat%
END IF
a00% = ScrollBar(0, 0)
a01% = ScrollBar(0, 1)
a10% = ScrollBar(1, 0)
a11% = ScrollBar(1, 1)
IF (Jerry.x > 311 AND Jerry.x < 319 AND Jerry.y > 11 AND Jerry.y < 19) THEN
mouse.hide
        ScrollBar(1, 0) = ScrollBar(1, 0) - ScrollBar(2, 1) * CSNG(rat%)
        ScrollBar(1, 1) = ScrollBar(1, 1) - ScrollBar(2, 1) * CSNG(rat%)
        IF (ScrollBar(1, 0) < 20!) THEN
        ScrollBar(1, 1) = ScrollBar(1, 1) + 20! - ScrollBar(1, 0)
        ScrollBar(1, 0) = 20!
        END IF
grp.notbox 314, CINT(ScrollBar(1, 1)) + 1, 316, a11%
grp.notbox 314, CINT(ScrollBar(1, 0)), 316, a10% - 1
Piccentre.y = Piccentre.y + rat%
IF (Piccentre.y - charlimity1 > (Resolution.y + 3) \ 2) THEN Piccentre.y = Piccentre.y - rat% ELSE sof.display "zzzzzzzz.ini", Piccentre.x, Piccentre.y, ActiveSlide&
mouse.show
ELSEIF (Jerry.x > 311 AND Jerry.x < 319 AND Jerry.y > 191 AND Jerry.y < 199) THEN
mouse.hide
        ScrollBar(1, 0) = ScrollBar(1, 0) + ScrollBar(2, 1) * CSNG(rat%)
        ScrollBar(1, 1) = ScrollBar(1, 1) + ScrollBar(2, 1) * CSNG(rat%)
        IF (ScrollBar(1, 1) > 190!) THEN
        ScrollBar(1, 0) = ScrollBar(1, 0) + 190! - ScrollBar(1, 1)
        ScrollBar(1, 1) = 190!
        END IF
grp.notbox 314, a10%, 316, CINT(ScrollBar(1, 0)) - 1
grp.notbox 314, a11% + 1, 316, CINT(ScrollBar(1, 1))
Piccentre.y = Piccentre.y - rat%
IF (charlimity2 - Piccentre.y > (Resolution.y + 1) \ 2) THEN Piccentre.y = Piccentre.y + rat% ELSE sof.display "zzzzzzzz.ini", Piccentre.x, Piccentre.y, ActiveSlide&
mouse.show
ELSEIF (Jerry.x > 1 AND Jerry.x < 9 AND Jerry.y > 191 AND Jerry.y < 199) THEN
mouse.hide
        ScrollBar(0, 0) = ScrollBar(0, 0) - ScrollBar(2, 0) * CSNG(rat%)
        ScrollBar(0, 1) = ScrollBar(0, 1) - ScrollBar(2, 0) * CSNG(rat%)
        IF (ScrollBar(0, 0) < 10!) THEN
        ScrollBar(0, 1) = ScrollBar(0, 1) + 10! - ScrollBar(0, 0)
        ScrollBar(0, 0) = 10!
        END IF
grp.notbox CINT(ScrollBar(0, 1)) + 1, 194, a01%, 196
grp.notbox CINT(ScrollBar(0, 0)), 194, a00% - 1, 196
Piccentre.x = Piccentre.x + rat%
IF (Piccentre.x - charlimitx1 > (Resolution.x + 3) \ 2) THEN Piccentre.x = Piccentre.x - rat% ELSE sof.display "zzzzzzzz.ini", Piccentre.x, Piccentre.y, ActiveSlide&
mouse.show
ELSEIF (Jerry.x > 306 AND Jerry.x < 314 AND Jerry.y > 191 AND Jerry.y < 199) THEN
mouse.hide
        ScrollBar(0, 0) = ScrollBar(0, 0) + ScrollBar(2, 0) * CSNG(rat%)
        ScrollBar(0, 1) = ScrollBar(0, 1) + ScrollBar(2, 0) * CSNG(rat%)
        IF (ScrollBar(0, 1) > 300!) THEN
        ScrollBar(0, 0) = ScrollBar(0, 0) + 300! - ScrollBar(0, 1)
        ScrollBar(0, 1) = 300!
        END IF
grp.notbox a00%, 194, CINT(ScrollBar(0, 0)) - 1, 196
grp.notbox a01% + 1, 194, CINT(ScrollBar(0, 1)), 196
Piccentre.x = Piccentre.x - rat%
IF (charlimitx2 - Piccentre.x > (Resolution.x + 1) \ 2) THEN Piccentre.x = Piccentre.x + rat% ELSE sof.display "zzzzzzzz.ini", Piccentre.x, Piccentre.y, ActiveSlide&
mouse.show
END IF
END IF
END SUB

SUB win.scrollrefresh
SHARED ScrollBar() AS SINGLE
mouse.hide
LINE (311, 12)-(319, 199), 0, BF
LINE (1, 192)-(314, 199), 0, BF
CIRCLE (315, 15), 3, 255
PAINT (315, 15), 240, 255
CIRCLE (315, 195), 3, 255
PAINT (315, 195), 240, 255
CIRCLE (5, 195), 3, 255
PAINT (5, 195), 240, 255
CIRCLE (310, 195), 3, 255
PAINT (310, 195), 240, 255
LINE (315, 15)-(315, 195), 52
LINE (5, 195)-(310, 195), 52
grp.notbox CINT(ScrollBar(0, 0)), 194, CINT(ScrollBar(0, 1)), 196
grp.notbox 314, CINT(ScrollBar(1, 0)), 316, CINT(ScrollBar(1, 1))
mouse.show
END SUB

SUB win.scrolls
SHARED Resolution AS pixel, ScrollBar() AS SINGLE
mouse.hide
LINE (311, 12)-(319, 199), 0, BF
LINE (1, 192)-(314, 199), 0, BF
CIRCLE (315, 15), 3, 255
PAINT (315, 15), 240, 255
CIRCLE (315, 195), 3, 255
PAINT (315, 195), 240, 255
CIRCLE (5, 195), 3, 255
PAINT (5, 195), 240, 255
CIRCLE (310, 195), 3, 255
PAINT (310, 195), 240, 255
LINE (315, 15)-(315, 195), 52
LINE (5, 195)-(310, 195), 52
szx! = CSNG(Resolution.x + 1)
szy! = CSNG(Resolution.y + 1)
IF (szx! < (charlimitx2 - charlimitx1)) THEN szx! = (charlimitx2 - charlimitx1)
IF (szy! < (charlimity2 - charlimity1)) THEN szy! = (charlimity2 - charlimity1)
szx! = (CSNG(charlimitx2 - charlimitx1) / szx!) * 290!
szy! = (CSNG(charlimity2 - charlimity1) / szy!) * 170!
IF (szx! > 290!) THEN szx! = 290!
IF (szy! > 170!) THEN szy! = 170!
a1! = szx! / 2
ScrollBar(0, 0) = 155! - a1!
ScrollBar(0, 1) = 155! + a1!
a1! = szy! / 2
ScrollBar(1, 0) = 105! - a1!
ScrollBar(1, 1) = 105! + a1!
szx! = (290 - szx!) / CSNG(Resolution.x - charlimitx2 + charlimitx1)
szy! = (170 - szy!) / CSNG(Resolution.y - charlimity2 + charlimity1)
ScrollBar(2, 0) = szx!
ScrollBar(2, 1) = szy!
grp.notbox CINT(ScrollBar(0, 0)), 194, CINT(ScrollBar(0, 1)), 196
grp.notbox 314, CINT(ScrollBar(1, 0)), 316, CINT(ScrollBar(1, 1))
mouse.show
sof.resolution
sof.filename
END SUB

SUB win.tell (x%, y%, name$, tell$, clr1%, clr2%, clr3%, clr4%)
SHARED Lastcharpoint AS pixel
DIM Areas%(20000)
x1% = x% + LEN(name$) * 10
b1% = INSTR(tell$, CHR$(enter))
IF (b1% = 0) THEN y1% = y% + (LEN(tell$) \ LEN(name$)) * 10 + 30 ELSE y1% = y% + c.stringcount%(tell$, CHR$(enter)) * 10 + 40
mouse.hide
GET (x%, y%)-(x1%, y1%), Areas%
LINE (x%, y%)-(x1%, y1%), clr2%, BF
LINE (x% + 1, y% + 1)-(x1% - 1, y% + 14), clr1%, BF
c.dispstring name$, x% + 6, y% + 6, clr3%, 0, 0, 1.3, 1
a2$ = tell$
x2% = x% + 6
y2% = y% + 20
a3% = INT(LEN(name$) * 1.5)
IF (b1% <> 0) THEN c.dispstring tell$, x2%, y2%, clr4%, 0, 0, 1, 1
DO
IF (LEN(a2$) > a3%) THEN a1$ = LEFT$(a2$, a3%) ELSE a1$ = a2$
IF (b1% = 0) THEN c.dispstring a1$, x2%, y2%, clr4%, 0, 0, 1, 1
IF (a1$ = a2$) THEN EXIT DO
a2$ = RIGHT$(a2$, LEN(a2$) - a3%)
y2% = y2% + c.stringcount%(a1$, CHR$(enter)) * 10
IF (b1% = 0) THEN y2% = y2% + 10
LOOP
mouse.show
'Display
mouse.hide
DEF SEG = &HA000
DO
FOR yy& = y% TO y1%
FOR xx& = x% TO x1%
mem1& = 320& * yy& + xx&
POKE mem1&, NOT (PEEK(mem1&)) AND &HFF
IF INKEY$ <> "" THEN EXIT DO
LINE (xx&, y%)-(xx&, y%), a3%
LINE (xx&, y1%)-(xx&, y1%), a3%
NEXT
a3% = (a3% + 1) AND &HFF
SOUND 21000, .2
NEXT
LOOP
DEF SEG
LINE (x%, y%)-(x1%, y1%), 0, BF
PUT (x%, y%), Areas%
mouse.show
snd.click
END SUB

