'
' Bitmap editor
' Made by Olle Bergkvist
' Licnsed under GNU GPL
'
' Use this program to load and edit a bitmap file.
'
' It works only for Microsoft bitmaps in 24-bit color, or a similar format.
'
' Not-yet-beta version, very experimental
'
' Bugchangelog
' 20061206 fixed some ugly bugs related to wide bitmaps
'          fixed that the keyboard buffer became filled
'

DEFINT A-Z

DECLARE SUB StatusBar (Text$)
DECLARE SUB GetInput (mousex%, mousey%, lb%, rb%, keyn%, FuncNum%, FastBool%)
DECLARE SUB FillArray (x1, x2, y1, y2, value)
DECLARE SUB Fill ()
DECLARE FUNCTION Recursive% (x%, y%, findcolor%)
DECLARE SUB Pencil ()
DECLARE SUB Lines ()
DECLARE SUB PickColor ()
DECLARE SUB Save ()
DECLARE SUB Quit ()
DECLARE SUB Delay (time!)

DIM SHARED MemAdress&
DIM SHARED DoFuncNum%
DIM SHARED DrawColor%
DIM SHARED DrawColorTwo%

DIM SHARED KeyMap%(255)
DIM SHARED ScreenMap%(160, 100)
DIM SHARED MyPalette&(0 TO 256)
DIM SHARED bmp AS STRING * 3
DIM SHARED onechar AS STRING * 1
DIM SHARED xsize&, ysize&, xcut&, ycut&
DIM SHARED linebytes%

CONST true = 1
CONST false = 0
CONST filltoolcolor = 250

' Mouse routines

' I found these mouse routines in ChetOS

' The guy who wrote ChetOS found them somewhere else...
' Thanks to anyone who wrote them :-D
'
' This mouse script uses "CALL ABSOLUTE" and that means you have to load
' QuickBasic with the file QB.QLB. Start QB from the command line in example:
'ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
'³ C:\QuickBasic\QB.EXE QB.QLB MOUSE.BAS ³
'ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
'                        www.olle.tk

DECLARE FUNCTION mouseInit% ()
DECLARE SUB MouseRange (x1%, y1%, x2%, y2%)
DECLARE SUB MouseDriver (ax%, bx%, cx%, dx%)
DECLARE SUB MousePut (mousex%, mousey%)
DECLARE SUB MouseStatus (lb%, rb%, mousex%, mousey%)
DECLARE SUB MouseShow ()
DECLARE SUB MouseHide ()

COMMON SHARED mouse$

' Mouse HEX Assemble Code
DATA 55,89,E5,8B,5E,0C,8B,07,50,8B,5E,0A,8B,07,50,8B
DATA 5E,08,8B,0F,8B,5E,06,8B,17,5B,58,1E,07,CD,33,53
DATA 8B,5E,0C,89,07,58,8B,5E,0A,89,07,8B,5E,08,89,0F
DATA 8B,5E,06,89,17,5D,CA,08,00


'############### Start main code ####################

CLS

ini$ = "BMP.INI"

OPEN ini$ FOR APPEND AS #1
inilof& = LOF(1)
CLOSE #1

IF inilof& < 2 THEN
  PRINT "Creating file " + ini$ + "..."
  OPEN ini$ FOR OUTPUT AS #1
  MemAdress& = &HA000
  PRINT #1, "A000"
  PRINT #1, "Ini file for BMPRCX. The first line is the memory segment in HEX to the graphics adapter. Should be A000 on most PCs. A800, B000, and B800 are also common. "
  PRINT #1, "If it doesnt work look at the Properties for your graphics card --> Memory intervals. 12345678 there means 4321 here."
  CLOSE #1

ELSE
  PRINT "Loading " + ini$ + "..."
  OPEN ini$ FOR INPUT AS #1
  INPUT #1, dum$
  MemAdress& = VAL("&H" + dum$)
  CLOSE #1
END IF:


FileName$ = LTRIM$(RTRIM$(COMMAND$))

IF FileName$ = "" THEN LINE INPUT "Input the file path to the BMP image or press Enter: ", FileName$
IF FileName$ = "" THEN SYSTEM


OPEN FileName$ FOR BINARY AS #1
filelen& = LOF(1)
IF filelen& < 2 THEN BEEP: PRINT "File does not exist!": CLOSE : KILL FileName$: SLEEP: SYSTEM

SCREEN 13
CLS

'######################### Mouse code ########################

' Puts HEX info into Mouse$
mouse$ = SPACE$(57)
FOR i% = 1 TO 57
  READ a$
  h$ = CHR$(VAL("&H" + a$))
  MID$(mouse$, i%, 1) = h$
NEXT i%
  DEF SEG = VARSEG(mouse$)
mouesadr% = SADD(mouse$)


' Sets inital varibles for mouse. Detects mouse
ax% = 3
MouseDriver ax%, bx%, cx%, dx%
lb% = ((bx% AND 1) <> 0)
rb% = ((bx% AND 2) <> 0)
mousex% = cx%
mousey% = dx%
'mouseInit
MouseDriver 0, 0, 0, 0
          
MouseRange 0, 0, 639, 199

MouseShow

MouseHide


'############################## Start BMP editor code  #################################

DEF SEG = MemAdress&

'---------------------- set up the PALETTE

attribute = 0

FOR blue = 0 TO 5
FOR green = 0 TO 5
FOR red = 0 TO 5

  'explanation to line below:
  'colornum& = 65536 * 12 * blue + 256 * 12 * green + 12 * red
 
  colornum& = 786432 * blue + 3072 * green + 12 * red
 
  MyPalette&(attribute) = colornum&
  'PALETTE attribute, colornum&

  attribute = attribute + 1

NEXT red, green, blue

PALETTE USING MyPalette&

'----------------- The on-screen palette

attribute = 0

FOR y = 0 TO 71

  IF y MOD 2 THEN attribute = attribute - 6

  FOR x = 308 TO 319
 
    POKE 320& * y + x, attribute

    IF x MOD 2 THEN attribute = attribute + 1

  NEXT x

NEXT y

'------------------ The toolbox

FOR y& = 191 TO 72 STEP -1


  FOR x& = 308 TO 319
   
   READ pxlcolor
   
    POKE 320 * y& + x&, pxlcolor

  NEXT

  READ tal

NEXT

'------------------ BMP loading starts

   FOR F = 0 TO 3
     GET #1, F + 19, onechar
     xsize& = xsize& + ASC(onechar) * 256 ^ F      'get the width...
   NEXT
  
   FOR F = 0 TO 3
     GET #1, F + 23, onechar
     ysize& = ysize& + ASC(onechar) * 256 ^ F      '...and height of the picture
   NEXT

linebytes = (filelen& - 54) / ysize& - 3 * xsize& 'the BMP format is a bit weird,
                                                  'so i need to calculate how many
                                                  '"new-line-bytes" each line has

                   
IF xsize& < 308 THEN xcut& = xsize& ELSE xcut& = 307: BEEP: StatusBar "Picture is very wide. It will be cut off.": Delay (1)
IF ysize& < 192 THEN ycut& = ysize& ELSE ycut& = 191: BEEP: StatusBar "Picture is very high. It will be cut off.": Delay (1)

StatusBar "Loading picture..."



SEEK #1, 55 + (3 * xsize& + linebytes) * (ysize& - ycut&)


FOR y = ycut& - 1 TO 0 STEP -1     '------------------------ loop start
  FOR x = 0 TO xcut& - 1
    
    IF EOF(1) THEN
      BEEP: StatusBar "ERROR: Unexcpected end of file!": Delay (1)
      BEEP: StatusBar "The BMP must be in high quality color.": Delay (1)
      SYSTEM
    END IF

    GET #1, , bmp                           'get RGB vlues:
   
      b = ASC(LEFT$(bmp, 1))               'blue
      g = ASC(MID$(bmp, 2))                'green
      r = ASC(RIGHT$(bmp, 1))              'red

         

    blue = INT(b / 48)
    green = INT(g / 48)
    red = INT(r / 48)

    pxlcolor = 36 * blue + 6 * green + red
   
    'IF x < 308 AND y < 192 THEN
      POKE 320& * y + x, pxlcolor
    'END IF
   
    'PSET (x, y), pxlcolor


  NEXT x

 
           'skip the annoying "new line-bytes"
 
  SEEK #1, SEEK(1) + 3 * (xsize& - xcut&) + linebytes

NEXT y                          '-------------------------- loop end



' ============ The function list ============

CONST FPencil = 1
CONST FFill = 2
CONST FSave = 3
CONST FQuit = 4
CONST FLines = 5
CONST FPickColor = 6


' ========    The keyboard and screen mappings  ======


KeyMap(1) = FQuit
KeyMap(59) = FSave
KeyMap(63) = FPencil
KeyMap(64) = FLines
KeyMap(65) = FFill
KeyMap(62) = FPickColor

FillArray 154, 159, 36, 40, FQuit
FillArray 154, 159, 42, 46, FSave
FillArray 154, 159, 48, 53, FPencil
FillArray 154, 159, 54, 59, FLines
FillArray 154, 159, 60, 65, FFill
FillArray 154, 159, 66, 71, FPickColor


DrawColor = 0
DrawColorTwo = 215

MouseShow

StatusBar "Ready! Use keys Esc and F1-F12 or click."

GetInput 0, 0, 0, 0, 0, DoFuncNum, false

IF DoFuncNum = 0 THEN DoFuncNum = FPencil

DO

  '============ Main loop =============

  SELECT CASE DoFuncNum
    CASE FPencil: Pencil
    CASE FFill: Fill
    CASE FLines: Lines
    CASE FPickColor: PickColor
    CASE FSave: Save
    CASE FQuit: Quit
  END SELECT


LOOP



'============================    End of code, only DATA etc.   ===================

'The DATA for the toolbox
'i used a prog i made to write the DATA statemants automatically (i'm not as crazy as i typed 10KB nonsense ;-) )


DATA,,,,,,,,,,,,
DATA,,,,,,,,,,,,
DATA,,,,,,,,,,,,
DATA,,,,,,,,,,,,
DATA,,,,,,,,,,,,
DATA,,,,,,,,,,,,
DATA,,,,,,,,,,,,
DATA,,,,,,,,,,,,
DATA,,,,,,,,,,,,
DATA,,,,,,,,,,,,
DATA,,,,,,,,,,,,
DATA,,,,,,,,,,,,
DATA,,,,,,,,,,,,
DATA,,,,,,,,,,,,
DATA,,,,,,,,,,,,
DATA,,,,,,,,,,,,
DATA,,,,,,,,,,,,
DATA,,,,,,,,,,,,
DATA,,,,,,,,,,,,
DATA,,,,,,,,,,,,
DATA,,,,,,,,,,,,
DATA,,,,,,,,,,,,
DATA,,,,,,,,,,,,
DATA,,,,,,,,,,,,
DATA,,,,,,,,,,,,
DATA,,,,,,,,,,,,
DATA,,,,,,,,,,,,
DATA,,,,,,,,,,,,
DATA,,,,,,,,,,,,
DATA,,,,,,,,,,,,
DATA,,,,,,,,,,,,
DATA,,,,,,,,,,,,
DATA,,,,,,,,,,,,
DATA,,,,,,,,,,,,
DATA,,,,,,,,,,,,
DATA,,,,,,,,,,,,
DATA,,,,,,,,,,,,
DATA,,,,,,,,,,,,
DATA,,,,,,,,,,,,
DATA,,,,,,,,,,,,
DATA,,,,,,,,,,,,
DATA,,,,,,,,,,,,
DATA,,,,,,,,,,,,
DATA,,,,,,,,,,,,
DATA,,,,,,,,,,,,
DATA,,,,,,,,,,,,
DATA,,,,,,,,,,,,
DATA,,,,,,,,,,,,
DATA,86,86,86,86,86,86,86,86,86,86,86,
DATA,172,172,172,172,172,172,172,172,172,172,172,
DATA,172,172,172,172,172,172,172,172,172,172,172,
DATA,172,126,,,126,126,172,172,172,172,172,
DATA,172,172,,215,,172,172,172,172,172,172,
DATA,172,172,172,,215,,172,172,172,172,172,
DATA,172,172,172,172,,215,,,172,172,172,
DATA,172,172,172,172,172,,,,172,172,172,
DATA,172,172,172,172,172,,,,,172,172,
DATA,172,172,172,172,172,172,172,172,,172,172,
DATA,172,172,172,172,172,172,172,172,172,172,172,
DATA,172,172,172,172,172,172,172,172,172,172,172,
DATA,86,86,86,86,86,86,86,86,86,86,86,
DATA,172,172,172,172,172,172,172,172,172,172,172,
DATA,172,172,172,172,172,172,172,172,172,172,172,
DATA,172,172,,172,172,172,,172,172,172,172,
DATA,172,172,,172,172,,,126,172,172,172,
DATA,172,172,,172,,,,,126,172,172,
DATA,172,172,,,126,126,,,,,172,
DATA,172,172,,172,126,126,126,,,172,172,
DATA,172,172,172,,172,215,215,,172,172,172,
DATA,172,172,172,172,172,172,,172,172,172,172,
DATA,172,172,172,172,172,172,172,172,172,172,172,
DATA,172,172,172,172,172,172,172,172,172,172,172,
DATA,86,86,86,86,86,86,86,86,86,86,86,
DATA,172,172,172,172,172,172,172,172,172,172,172,
DATA,172,172,172,172,172,172,172,172,172,172,172,
DATA,172,172,172,172,172,172,172,172,,172,172,
DATA,172,172,172,172,172,172,172,,172,172,172,
DATA,172,172,172,172,172,172,,172,172,172,172,
DATA,172,172,172,172,172,,172,172,172,172,172,
DATA,172,172,172,172,,172,172,172,172,172,172,
DATA,172,172,172,,172,172,172,172,172,172,172,
DATA,172,172,,172,172,172,172,172,172,172,172,
DATA,172,172,172,172,172,172,172,172,172,172,172,
DATA,172,172,172,172,172,172,172,172,172,172,172,
DATA,86,86,86,86,86,86,86,86,86,86,86,
DATA,172,172,172,172,172,172,172,172,172,172,172,
DATA,172,172,172,172,172,172,172,172,172,172,172,
DATA,172,172,172,,172,172,172,172,172,172,172,
DATA,172,172,172,,,172,172,172,172,172,172,
DATA,172,172,172,,215,,172,172,172,172,172,
DATA,172,172,172,172,215,172,172,172,172,172,172,
DATA,172,172,172,172,,215,,172,172,172,172,
DATA,172,172,172,172,172,,215,172,172,172,172,
DATA,172,172,172,172,172,,3,,172,172,172,
DATA,172,172,172,172,172,172,172,172,172,172,172,
DATA,172,172,172,172,172,172,172,172,172,172,172,
DATA,,,,,,,,,,,,
DATA,,,,,,,,,,,,
DATA,86,86,86,86,86,86,86,86,86,86,43,
DATA,172,172,172,172,172,172,172,172,172,172,43,
DATA,172,,14,,,,172,14,172,172,43,
DATA,172,,14,,,,172,14,172,172,43,
DATA,172,,14,14,14,14,14,14,172,172,43,
DATA,172,,,172,172,172,172,14,172,172,43,
DATA,172,,,172,172,172,172,14,172,172,43,
DATA,172,,,172,172,172,172,,172,172,43,
DATA,172,,,,,,,,172,172,43,
DATA,172,172,172,172,172,172,172,172,172,172,43,
DATA,,,,,,,,,,,,
DATA,,,,,,,,,,,,
DATA,86,86,86,86,86,86,86,86,86,86,86,
DATA,172,172,172,172,172,172,172,172,172,172,86,
DATA,172,,,172,172,172,172,,,172,86,
DATA,172,172,,,172,172,,,172,172,86,
DATA,172,172,172,,,,,172,172,172,86,
DATA,172,172,172,172,,,172,172,172,172,86,
DATA,172,172,172,,,,,172,172,172,86,
DATA,172,172,,,172,172,,,172,172,86,
DATA,172,,,172,172,172,172,,,172,86,
DATA,172,172,172,172,172,172,172,172,172,172,86,

'End of the toolbox DATA


'End of code

SUB Delay (time!)

start! = TIMER

DO
  dum$ = INKEY$
LOOP WHILE start! + time! > TIMER

END SUB

SUB Fill

DO' <<------------------

StatusBar ("Fill tool. Click where to fill.")

GetInput mousex, mousey, lb, rb, keyn, DoFuncNum, false

IF DoFuncNum THEN EXIT SUB

StatusBar ("Filling... please wait")

MouseHide

findcolor = PEEK(320& * mousey + mousex)

IF lb THEN fillcolor = DrawColor
IF rb THEN fillcolor = DrawColorTwo


IF fillcolor <> findcolor AND mousex < 308 AND mousey < 192 THEN

  ' an ugly trick that makes filledtoolcolor look like fillcolor
  PALETTE filltoolcolor, MyPalette&(fillcolor)

  '----change the clicked pixel to filltoolcolor
  POKE 320& * mousey + mousex, filltoolcolor

  FOR startx = mousex - 1 TO mousex + 1
  FOR starty = mousey - 1 TO mousey + 1
    IF (startx = mousex XOR starty = mousey) AND startx > -1 AND starty > -1 AND startx < 308 AND starty < 192 THEN

      buffer$ = ""
      bufferpos = 1
      x = startx
      y = starty

      DO

        '---- search for findcolor
        IF PEEK(320& * y + x) = findcolor THEN

          fillflag = 0

          '--- search for filltoolcolor near findcolor

            'x+1,y
            IF x > -2 AND y > -1 AND x < 307 AND y < 192 AND fillflag = 0 THEN
              IF PEEK(320& * y + x + 1) = filltoolcolor THEN fillflag = 1
            END IF

            'x-1,y
            IF x > 0 AND y > -1 AND x < 309 AND y < 192 AND fillflag = 0 THEN
              IF PEEK(320& * y + x - 1) = filltoolcolor THEN fillflag = 1
            END IF

            'x,y+1
            IF x > -1 AND y > -2 AND x < 308 AND y < 191 AND fillflag = 0 THEN
              IF PEEK(320& * y + 320& + x) = filltoolcolor THEN fillflag = 1
            END IF

            'x,y-1
            IF x > -1 AND y > 0 AND x < 308 AND y < 193 AND fillflag = 0 THEN
              IF PEEK(320& * y - 320& + x) = filltoolcolor THEN fillflag = 1
            END IF

          '----- change findcolor to filltoolcolor and add new coordinates to the buffer
          IF fillflag THEN
       
            POKE 320& * y + x, filltoolcolor


              'x+1,y
              IF x > -2 AND y > -1 AND x < 307 AND y < 192 THEN
                IF PEEK(320& * y + x + 1) = findcolor THEN buffer$ = buffer$ + CHR$(ABS(x > 254)) + CHR$((x + 1) MOD 256) + CHR$(y)
              END IF

              'x-1,y
              IF x > 0 AND y > -1 AND x < 309 AND y < 192 THEN
                IF PEEK(320& * y + x - 1) = findcolor THEN buffer$ = buffer$ + CHR$(ABS(x > 256)) + CHR$((x - 1) MOD 256) + CHR$(y)
              END IF

              'x,y+1
               IF x > -1 AND y > -2 AND x < 308 AND y < 191 THEN
                IF PEEK(320& * y + 320& + x) = findcolor THEN buffer$ = buffer$ + CHR$(ABS(x > 255)) + CHR$(x MOD 256) + CHR$(y + 1)
               END IF

              'x,y-1
              IF x > -1 AND y > 0 AND x < 308 AND y < 193 THEN
                IF PEEK(320& * y - 320& + x) = findcolor THEN buffer$ = buffer$ + CHR$(ABS(x > 255)) + CHR$(x MOD 256) + CHR$(y - 1)
              END IF


          END IF

        END IF

        IF LEN(buffer$) > 10000 THEN
          buffer$ = MID$(buffer$, bufferpos, LEN(buffer$) - bufferpos + 1)
          bufferpos = 1
        END IF

        IF LEN(buffer$) < bufferpos THEN
          x = -1
        ELSE
          x = 256 * ASC(MID$(buffer$, bufferpos, 1))
          x = x + ASC(MID$(buffer$, bufferpos + 1, 1))
          y = ASC(MID$(buffer$, bufferpos + 2, 1))
          bufferpos = bufferpos + 3
        END IF

      LOOP UNTIL x = -1


    END IF
  NEXT
  NEXT

  '-----replace all filltoolcolor to fillcolor
  FOR x = 0 TO 307
  FOR y = 0 TO 191

    IF PEEK(320& * y + x) = filltoolcolor THEN
      POKE 320& * y + x, fillcolor
    END IF

  NEXT y
  NEXT x

END IF

MouseShow



LOOP' <<----------

END SUB

SUB FillArray (x1, x2, y1, y2, value)

FOR x = x1 TO x2
FOR y = y1 TO y2

  ScreenMap(x, y) = value

NEXT
NEXT

END SUB

SUB GetInput (mousex, mousey, lb, rb, keyn, FuncNum, FastBool)

DEF SEG = VARSEG(mouse$)

DO

   MouseDriver 3, bx, mousex, mousey
   lb = ((bx AND 1) <> 0)
   rb = ((bx AND 2) <> 0)

   keyn = INP(96)
   dum$ = INKEY$

LOOP UNTIL (keyn > 0 AND keyn < 129) OR lb OR rb

IF FastBool = false THEN
  DO


     lb = tlb
     rb = trb
     mousex = tempx
     mousey = tempy
     keyn = tkeyn
  
     MouseDriver 3, bx, tempx, tempy
     tlb = ((bx AND 1) <> 0)
     trb = ((bx AND 2) <> 0)

     tkeyn = INP(96)
     dum$ = INKEY$

  LOOP WHILE ((tkeyn > 0 AND tkeyn < 129) OR tlb OR trb)
END IF

FuncNum = 0

'=== Function list ===

mousex = INT(mousex / 2)

xc = INT(mousex / 2)
yc = INT(mousey / 2)

IF xc < 160 AND yc < 100 THEN FuncNum = ScreenMap(xc, yc)

IF FuncNum = 0 THEN FuncNum = KeyMap(keyn)


IF mousex > 307 AND mousey < 73 THEN

  IF lb THEN DrawColor = 6 * INT(mousey / 2) + INT((mousex - 308) / 2)
  IF rb THEN DrawColorTwo = 6 * INT(mousey / 2) + INT((mousex - 308) / 2)

END IF

DEF SEG = MemAdress&
              
END SUB

SUB Lines

StatusBar ("Lines. Click in 2 places to draw a line.")

GetInput x2, y2, lb, rb, keyn, DoFuncNum, false

IF DoFuncNum THEN EXIT SUB

DO

  x1 = x2
  y1 = y2

  GetInput x2, y2, lb, rb, keyn, DoFuncNum, false

  IF DoFuncNum THEN EXIT SUB

  xdiff = x2 - x1
  ydiff = y2 - y1

  IF ABS(xdiff) > ABS(ydiff) THEN
    steps = ABS(xdiff)
  ELSE
    steps = ABS(ydiff)
  END IF

  IF steps THEN
    dx! = xdiff / steps
    dy! = ydiff / steps
  END IF


  x! = x1
  y! = y1

  FOR count = 1 TO steps
    x! = x! + dx!
    y! = y! + dy!

    IF x! < 308 AND y! < 192 THEN
      MouseHide

      IF lb THEN POKE 320 * INT(y!) + INT(x!), DrawColor
      IF rb THEN POKE 320 * INT(y!) + INT(x!), DrawColorTwo

      MouseShow
    END IF
  NEXT


LOOP

END SUB

SUB MouseDriver (ax%, bx%, cx%, dx%)
CALL absolute(ax%, bx%, cx%, dx%, SADD(mouse$))
END SUB

SUB MouseHide
DEF SEG = VARSEG(mouse$)
'mouseHide
MouseDriver 2, 0, 0, 0
DEF SEG = MemAdress&

END SUB

SUB MousePut (mousex%, mousey%)
ax% = 4
cx% = mousex%
dx% = mousey
MouseDriver ax%, 0, cx%, dx%


END SUB

DEFLNG A-Z
SUB MouseRange (x1%, y1%, x2%, y2%)

MRLeft% = x1%
MRRight% = x2%
MRTop% = y1%
MRBot% = y2%

ax% = 7
cx% = x1%
dx% = x2%
 MouseDriver ax%, 0, cx%, dx%
ax% = 8
cx% = y1%
dx% = y2%
 MouseDriver ax%, 0, cx%, dx%

END SUB

DEFINT A-Z
SUB MouseShow
DEF SEG = VARSEG(mouse$)
'mouseShow
MouseDriver 1, 0, 0, 0
DEF SEG = MemAdress&

END SUB

DEFSNG A-Z
 SUB MouseStatus (lb%, rb%, mousex%, mousey%)
' Mouse code that I didn't write, It gets the coord's for the mouse.
MouseDriver 3, bx%, cx%, dx%
lb% = ((bx% AND 1) <> 0)
rb% = ((bx% AND 2) <> 0)
mousex% = cx%
mousey% = dx%
         
END SUB

DEFINT A-Z
SUB Pencil


StatusBar ("Pencil: Hold down the mouse to draw.")


DO

  GetInput tempx, tempy, tlb, trb, tempkeyn, DoFuncNum, true

  IF DoFuncNum THEN EXIT SUB

  mouseseg = VARSEG(mouse$)
  DEF SEG = mouseseg
  offset = SADD(mouse$)

  DO '----



    DO

      lb = tlb
      rb = trb
      mousex = tempx
      mousey = tempy
      'keyn = tempkeyn

      CALL absolute(3, bx, tempx, tempy, offset)
      tempx = INT(tempx / 2)
      tlb = ((bx AND 1) <> 0)
      trb = ((bx AND 2) <> 0)

      'tempkeyn = INP(96)

    LOOP WHILE mousex = tempx AND mousey = tempy AND lb = tlb AND rb = trb 'AND keyn = tempkeyn




    'memadr& = (320& * mousey + mousex / 2)
    IF mousex < 308 AND mousey < 192 THEN
      'mouseHide
      MouseDriver 2, 0, 0, 0
      DEF SEG = MemAdress&

      IF lb THEN POKE 320& * mousey + mousex, DrawColor
      IF rb THEN POKE 320& * mousey + mousex, DrawColorTwo

      'mouseShow
      DEF SEG = mouseseg
      MouseDriver 1, 0, 0, 0
    END IF


  LOOP WHILE lb OR rb '----

  DEF SEG = MemAdress&

LOOP


END SUB

SUB PickColor

StatusBar ("Click at an area with the searched color.")

GetInput mousex, mousey, lb, rb, keyn, DoFuncNum, false

IF DoFuncNum THEN EXIT SUB

IF mousex < 308 AND mousey < 192 THEN

  MouseHide

  IF lb THEN DrawColor = PEEK(320& * mousey + mousex)
  IF rb THEN DrawColorTwo = PEEK(320& * mousey + mousex)

  MouseShow

END IF

DoFuncNum = FPencil


END SUB

SUB Quit


BEEP

StatusBar ("Save changes before exit? [Y=Yes] [N=No]")

DO

GetInput mousex, mousey, lb, rb, keyn, DoFuncNum, false

IF DoFuncNum THEN EXIT SUB

IF keyn = 49 THEN SYSTEM

IF keyn = 21 THEN Save: SYSTEM

LOOP
END SUB

SUB Save

StatusBar ("Saving bitmap, please wait...")

MouseHide




SEEK #1, 55 + (3 * xsize& + linebytes) * (ysize& - ycut&)


FOR y = ycut& - 1 TO 0 STEP -1     '------------------------ loop start
  FOR x = 0 TO xcut& - 1
   
    IF EOF(1) THEN
      BEEP: StatusBar "ERROR: Unexcpected end of file!": Delay (1)
      BEEP: StatusBar "The BMP must be in high quality color.": Delay (1)
      SYSTEM
    END IF

    IF x < 308 AND y < 192 THEN
      pxlcolor = PEEK(320& * y + x)
      'pxlcolor = POINT(x, y)

                                              'get RGB vlues:
      blue = INT(pxlcolor / 36)
        pxlcolor = pxlcolor - 36 * blue
      green = INT(pxlcolor / 6)
        pxlcolor = pxlcolor - 6 * green
      red = pxlcolor


      b = blue * 48
      g = green * 48
      r = red * 48

      bmp = CHR$(b) + CHR$(g) + CHR$(r)
     
      PUT #1, , bmp
   
    ELSE SEEK #1, SEEK(1) + 3
   
    END IF

  NEXT x

     'skip the annoying "new line-bytes"

  SEEK #1, SEEK(1) + 3 * (xsize& - xcut&) + linebytes


NEXT y                          '-------------------------- loop end


MouseShow

DoFuncNum = FPencil

END SUB

SUB StatusBar (Text$)

MouseHide

COLOR 0
LOCATE 25, 1
PRINT STRING$(40, 32);

COLOR 170
LOCATE 25, 1
PRINT LEFT$(Text$, 40);

MouseShow

END SUB