Sorry your browser is not supported!

Rem ***** Main Source File *****
#constant MAX_BITMAPS   255
#constant FALSE         0
#constant TRUE          1
#constant BITMAP_VIEW   1
#constant BITMAP_STORE  2
#constant BITMAP_LARGE  256


#constant IMAGE_VIEW    1
#constant SPRITE_VIEW   1

#constant _WIDTH         1024
#constant _HEIGHT        768
#constant _BPP           32

#constant MAX_WIDTH     64
#constant MAX_HEIGHT    64

#constant _DLL           1
#constant CANCEL         -1

#constant NONE          0
#constant HORZ          1<<0
#constant VERT          1<<1
#constant DIAG          1<<2

#constant PROGRAMVERSION "Version : 0.0.0.1"

if check display mode (_WIDTH,_HEIGHT,_BPP)=0
   print "You must be able to run 1024x768x32"
   wait key
   end
endif

set display mode _WIDTH,_HEIGHT,_BPP
sync on
sync rate 0
cls 0:sync

randomize timer()
dim map(MAX_WIDTH,MAX_HEIGHT)
gridWidth as integer
gridHeight as integer
mX as integer
pMX as integer
mY as integer
pMY as integer
mC as integer
kP as integer
currentBitmap as integer
mirror as integer
plottingColour as DWORD
global ptr as DWORD

gridWidth=64
gridHeight=64
currentBitmap=1
mirror=NONE
plottingColour=RGB(255,0,0)
cls 0

load dll "FONTEDITOR.DLL",_DLL

ptr=calloc(1024)
createAllBitmaps(gridWidth,gridHeight)
createViewBitmap(gridWidth,gridHeight)
displayGrid(gridWidth,gridHeight)
displayOptions(gridWidth)
displayCurrentBitmap(currentBitmap,gridWidth,gridHeight)

REM *********************
REM * MAIN PROGRAM LOOP *
REM *********************

pMX=mouseX()
pMY=mouseY()
mX=pMX
mY=pMY
do
   repeat
      mC=mouseClick()
      kP=scancode()

      if mX<>pMX or mY<>pMY
         highlightBox(pMX,pMY,FALSE,gridWidth,gridHeight)
      endif

      highlightBox(mX,mY,TRUE,gridWidth,gridHeight)
      pMX=mX
      pMY=mY

      if kP<>0
         select kP
            case  34 :  REM Goto a line
                        newGoto=call dll (_DLL,"?goToBitmap@@YAHXZ",currentBitmap)
                        if newGoto<>CANCEL
                           currentBitmap=newGoto
                           displayCurrentBitmap(currentBitmap,gridWidth,gridHeight)
                        endif
                        endcase

            case  31 :  REM Select grid size
                        newGridSize=call dll (_DLL,"?getGridSize@@YAHH@Z",gridWidth)
                        if newGridSize<>CANCEL
                           cls 0
                           sync
                           gridWidth=newGridSize
                           gridHeight=newGridSize
                           createAllBitmaps(gridWidth,gridHeight)
                           createViewBitmap(gridWidth,gridHeight)
                           displayGrid(gridWidth,gridHeight)
                           displayOptions(gridWidth)
                           displayCurrentBitmap(currentBitmap,gridWidth,gridHeight)
                        endif
                        endcase
            case  80 :  REM Scroll down
                        scrollDown(gridWidth,gridHeight,plottingColour)
                        endcase
            case  72 :  REM Scroll up
                        scrollUp(gridWidth,gridHeight,plottingColour)
                        endcase
            case  77 :  REM Scroll right
                        scrollRight(gridWidth,gridHeight,plottingColour)
                        endcase
            case  75 :  REM Scroll left
                        scrollLeft(gridWidth,gridHeight,plottingColour)
                        endcase
            case  13 :  REM Next Bitmap
                        inc currentBitmap
                        if currentBitmap>MAX_BITMAPS
                           currentBitmap=MAX_BITMAPS
                        endif
                        displayCurrentBitmap(currentBitmap,gridWidth,gridHeight)
                        endcase
            case  12 :  REM Previous bitmap
                        dec currentBitmap
                        if currentBitmap<1
                           currentBitmap=1
                        endif
                        displayCurrentBitmap(currentBitmap,gridWidth,gridHeight)
                        endcase
            case  59 :  REM Mirroring options
                        result=call dll(_DLL,"?mirroring@@YAHH@Z",mirror)
                        if result<>CANCEL
                           mirror=result
                        endif
                        endcase
            case  60 :  REM Set plotting colour
                        plottingColour=_getColour(plottingColour)
                        x=msgbox(hex$(plottingColour),"*",1)
                        endcase
            case  63 :  REM Save current bitmap as binary
                        saveBinary(currentBitmap,currentBitmap,gridWidth,gridHeight)
                        endcase
            case  64 :  REM Save all bitmaps as binary
                        saveBinary(1,MAX_BITMAPS,gridWidth,gridHeight)
                        endcase
            case  65 :  REM Save current bitmap to file
                        saveBitmap(currentBitmap,currentBitmap,gridWidth,gridHeight)
                        endcase
            case  66 :  REM Save all bitmaps to file
                        if shiftkey()=0
                           saveBitmap(1,MAX_BITMAPS,gridWidth,gridHeight)
                        endif
                        endcase
            case  67 :  REM F9 - Save into 1 big bitmap
                        saveAsOneBitmap(gridWidth,gridHeight)
                        endcase
            case  68 :  REM F10 - Copy to current bitmap
                        if image exist(IMAGE_VIEW)<>0
                           delete image IMAGE_VIEW
                        endif

                        set current bitmap BITMAP_VIEW
                        get image IMAGE_VIEW,0,0,gridWidth,gridHeight,0
                        set current bitmap 0

                        set current bitmap (currentBitmap-1)+BITMAP_STORE
                        paste image IMAGE_VIEW,0,0,0
                        set current bitmap 0
                        displayCurrentBitmap(currentBitmap,gridWidth,gridHeight)
                        endcase
            case  87 :  REM F11 - Clear the grid
                        displayGrid(gridWidth,gridHeight)
                        createViewBitmap(gridWidth,gridHeight)
                        displayViewBitmap(gridWidth,gridHeight)
                        sync
                        endcase
            case  88 :  REM F12 - Exit program
                        if MsgBox("Are you sure you want to exit this program ?",_
                                  "* Exit Program *",_
                                  MB_YESNO)=IDYES
                           delete memory ptr
                           end
                        endif
                        endcase
         endselect
         `ink rgb(255,255,0),0:print kP
      endif
      mX=mouseX()
      mY=mouseY()

   until mC<>0

   select mC
      case  1  :  REM Left button pressed
                  plotPixel(mX,mY,TRUE,gridWidth,gridHeight,mirror,plottingColour)
                  displayViewBitmap(gridWidth,gridHeight)
                  endcase
      case  2  :  REM Right button pressed
                  plotPixel(mX,mY,FALSE,gridWidth,gridHeight,mirror,plottingColour)
                  displayViewBitmap(gridWidth,gridHeight)
                  endcase
   endselect
loop

REM Hightlight box which mouse is over
function highlightBox(mX as integer,mY as integer,highlight as integer,_
                      gridWidth as integer,gridHeight as integer)
local aX as integer
local aY as integer

   aX=mX/8
   aY=mY/8
   if aX>=0 and aX<=gridWidth-1 and _
      aY>=0 and aY<=gridHeight-1
      if highlight=TRUE
         ink rgb(rnd(256),rnd(256),rnd(256)),0
      else
         ink 0,0
      endif

      line (aX*8)-1,(aY*8)-1,(aX*8)+8,(aY*8)-1
      line (aX*8)+7,(aY*8)-1,(aX*8)+7,(aY*8)+8
      line (aX*8)-1,(aY*8)+7,(aX*8)+8,(aY*8)+7
      line (aX*8)-1,(aY*8)-1,(aX*8)-1,(aY*8)+7
   endif
   sync
endfunction

function _getColour(plottingColour as DWORD)
local result as DWORD
local r as integer
local g as integer
local b as integer

   r=(plottingColour>>16) && 255
   g=(plottingColour>>8) && 255
   b=plottingColour && 255

   result=(b<<16)+(g<<8)+r
   if GetColour(ptr,CC_RGBINIT || CC_FULLOPEN,0,result)>0
      r=peekB(ptr,0)
      g=peekB(ptr,1)
      b=peekB(ptr,2)
      result=(r<<16)+(g<<8)+b
   else
      result=plottingColour
   endif
endfunction result

REM Put a pixel in the main display and update the actual size bitmap
function __plotPixel(aX as integer,aY as integer,plot as integer,_
                      gridWidth as integer,gridHeight as integer,_
                      plottingColour as DWORD)
   if aX>=0 and aX<=gridWidth-1 and _
      aY>=0 and aY<=gridHeight-1
      if plot=TRUE
         ink plottingColour,0
      else
         ink rgb(255,255,255),0
      endif

      box aX*8,aY*8,(aX*8)+7,(aY*8)+7

      set current bitmap BITMAP_VIEW
      if plot=TRUE
         dot aX,aY,plottingColour
         map(aX,aY)=plottingColour
      else
         dot aX,aY,0
         map(aX,aY)=0
      endif
      set current bitmap 0
   endif
   sync
endfunction

function plotPixel(mX as integer,mY as integer,plot as integer,_
                   gridWidth as integer,gridHeight as integer,_
                   mirror as integer,_
                   plottingColour as DWORD)
local aX as integer
local aY as integer

   aX=mX/8
   aY=mY/8

   __plotPixel(aX,aY,plot,gridWidth,gridHeight,plottingColour)

   REM Now check for horizontal mirroring
   if mirror && HORZ
      __plotPixel(gridWidth-aX-1,aY,plot,gridWidth,gridHeight,plottingColour)
   endif

   if mirror && VERT
      __plotPixel(aX,gridHeight-aY-1,plot,gridWidth,gridHeight,plottingColour)
   endif

   if mirror && DIAG
      __plotPixel(gridWidth-aX-1,gridHeight-aY-1,plot,gridWidth,gridHeight,plottingColour)
   endif
endfunction


REM Display an empty grid
function displayGrid(gridWidth as integer,gridHeight as integer)
local x as integer
local y as integer

   ink rgb(255,255,255),0
   for x=0 to gridWidth-1
      for y=0 to gridHeight-1
         box x*8,y*8,(x*8)+7,(y*8)+7
         map(x,y)=0
      next y
   next x
   sync
endfunction

function createViewBitmap(gridWidth as integer,gridHeight as integer)
   if bitmap exist(BITMAP_VIEW)<>0
      delete bitmap BITMAP_VIEW
   endif

   create bitmap BITMAP_VIEW,gridWidth,gridHeight
   set current bitmap BITMAP_VIEW
   cls 0
   set current bitmap 0
endfunction

function displayViewBitmap(gridWidth as integer,gridHeight as integer)
   if image exist(IMAGE_VIEW)<>0
      delete image IMAGE_VIEW
   endif

   set current bitmap BITMAP_VIEW
   get image IMAGE_VIEW,0,0,gridWidth,gridHeight,1
   set current bitmap 0

   paste image IMAGE_VIEW,screen width()-gridWidth-1,screen height()-gridHeight-1,0
   sync
endfunction

function displayOptions(gridWidth as integer)
local sW as integer
local text$ as string
local yP as integer

   yP=0
   restore
   read text$
   while text$<>"*"
      text 520,yP,text$
      inc yP,text height(text$)
      read text$
   endwhile

   text 900,0,PROGRAMVERSION
   sync
endfunction

function displayCurrentBitmap(currentBitmap as integer,gridWidth as integer,gridHeight as integer)
local text$ as string
local x as integer
local y as integer

   text$="Current Bitmap Selected : "+str$(currentBitmap)
   ink rgb(0,255,0),0
   x=0
   y=(gridHeight*8)+8
   box x,y,x+text width(text$)+32,y+text height(text$),0,0,0,0
   text x,y,text$

   rem Display the current selected bitmap
   if bitmap exist (currentBitmap)<>0
      if image exist(IMAGE_VIEW)<>0
         delete image IMAGE_VIEW
      endif

      x=0
      y=screen height()-gridHeight-2

      set current bitmap (currentBitmap-1)+BITMAP_STORE
      get image IMAGE_VIEW,0,0,gridWidth,gridHeight,1
      set current bitmap 0

      ink rgb(0,0,255),0
      line x,y,x+gridWidth+1,y
      line x+gridWidth+1,y,x+gridWidth+1,y+gridHeight+1
      line x,y+gridHeight+1,x+gridWidth+1,y+gridHeight+1
      line x,y,x,y+gridHeight+1

      paste image IMAGE_VIEW,x+1,y+1,0
   endif
   sync
endfunction

function deleteAllBitmaps()
local l as integer
local bM as integer

   for l=1 to MAX_BITMAPS
      bM=BITMAP_STORE+(l-1)
      if bitmap exist(bM)<>0
         delete bitmap bM
      endif
   next l
endfunction

function createAllBitmaps(gridWidth as integer,gridHeight as integer)
local l as integer
local bM as integer

   deleteAllBitmaps()
   for l=1 to MAX_BITMAPS
      bM=BITMAP_STORE+(l-1)
      create bitmap bM,gridWidth,gridHeight
   next l
endfunction

function saveBinary(startBitmap as integer,endBitmap as integer,_
                    gridWidth as integer,gridHeight as integer)
local l as integer
local x as integer
local y as integer
local fileName$ as string
local c as DWORD

   fileName$="C:\OUTPUT.DAT"
   if file exist(fileName$)<>0
      delete file fileName$
   endif

   open to write 1,fileName$
   write byte 1,gridWidth
   write byte 1,gridHeight
   for l=startBitmap to endBitmap
      if image exist(IMAGE_VIEW)<>0
         delete image IMAGE_VIEW
      endif

      set current bitmap (l-1)+BITMAP_STORE
      get image IMAGE_VIEW,0,0,gridWidth,gridHeight,0

      write byte 1,gridWidth
      write byte 1,gridHeight
      write byte 1,l
      for y=0 to gridHeight-1
         for x=0 to gridWidth-1
            write long 1,point(x,y)
         next x
      next y
      set current bitmap 0
   next l
endfunction

function saveBitmap(startBitmap as integer,endBitmap as integer,_
                    gridWidth as integer,gridHeight as integer)
local l as integer
local fileName$ as string

   fileName$="C:\OUTPUT"
   for l=startBitmap to endBitmap
      if image exist(IMAGE_VIEW)<>0
         delete image IMAGE_VIEW
      endif

      set current bitmap (l-1)+BITMAP_STORE
      get image IMAGE_VIEW,0,0,gridWidth,gridHeight,0
      set current bitmap 0

      if startBitmap=endBitmap
         save image fileName$+".BMP",IMAGE_VIEW
      else
         save image fileName$+str$(l)+".BMP",IMAGE_VIEW
      endif
   next l
endfunction

function saveAsOneBitmap(gridWidth as integer,gridHeight as integer)
local x as integer
local y as integer
local fileName$ as string
local xP as integer
local yP as integer

   fileName$="C:\OUTPUT.BMP"
   if file exist(fileName$)<>0
      delete file fileName$
   endif

   if bitmap exist(BITMAP_LARGE)<>0
      delete bitmap BITMAP_LARGE
   endif

   create bitmap BITMAP_LARGE,(16*gridWidth)+gridWidth,(16*gridHeight)+gridHeight

   l=1
   for y=1 to 16
      for x=1 to 16
         xP=(x-1)*gridWidth
         yP=(y-1)*gridHeight
         if l<=MAX_BITMAPS
            copy bitmap (l-1)+BITMAP_STORE,0,0,gridWidth,gridHeight,BITMAP_LARGE,xP,yP,xP+gridWidth,yP+gridHeight
         endif
         inc l
      next x
   next y

   set current bitmap BITMAP_LARGE
   if image exist(IMAGE_VIEW)<>0
      delete image IMAGE_VIEW
   endif
   get image IMAGE_VIEW,0,0,16*gridWidth,16*gridHeight
   set current bitmap 0
   save image fileName$,IMAGE_VIEW
endfunction

function updateGridAndView(gridWidth as integer,gridHeight as integer,_
                           plottingColour as DWORD)
local x as integer
local y as integer

   set current BITMAP BITMAP_VIEW
   cls 0
   set current bitmap 0

   for y=0 to gridHeight-1
      for x=0 to gridWidth-1
         if map(x,y)<>0
            __plotPixel(x,y,TRUE,gridWidth,gridHeight,plottingColour)
         else
            __plotPixel(x,y,FALSE,gridWidth,gridHeight,plottingColour)
         endif
      next x
   next y
endfunction

function scrollLeft(gridWidth as integer,gridHeight as integer,plottingColour as DWORD)
local x as integer
local y as integer

   for y=0 to gridHeight-1
      for x=1 to gridWidth-1
         map(x-1,y)=map(x,y)
      next x
      map(gridWidth-1,y)=0
   next y
   updateGridAndView(gridWidth,gridHeight,plottingColour)
endfunction

function scrollRight(gridWidth as integer,gridHeight as integer,plottingColour as DWORD)
local x as integer
local y as integer

   for y=0 to gridHeight-1
      for x=gridWidth-2 to 0 step -1
         map(x+1,y)=map(x,y)
      next x
      map(0,y)=0
   next y
   updateGridAndView(gridWidth,gridHeight,plottingColour)
endfunction

function scrollUp(gridWidth as integer,gridHeight as integer,plottingColour as DWORD)
local x as integer
local y as integer

   for y=1 to gridHeight-1
      for x=0 to gridWidth-1
         map(x,y-1)=map(x,y)
      next x
   next y

   for x=0 to gridWidth-1
      map(x,gridHeight-1)=0
   next x
   updateGridAndView(gridWidth,gridHeight,plottingColour)
endfunction

function scrollDown(gridWidth as integer,gridHeight as integer,plottingColour as DWORD)
local x as integer
local y as integer

   for y=gridHeight-2 to 0 step -1
      for x=0 to gridWidth-1
         map(x,y+1)=map(x,y)
      next x
   next y

   for x=0 to gridWidth-1
      map(x,0)=0
   next x
   updateGridAndView(gridWidth,gridHeight,plottingColour)
endfunction

REM ****************
REM * OPTIONS DATA *
REM ****************

DATA "+        - Next Bitmap"
DATA "-        - Previous Bitmap"
DATA "------------------------------------------------"
DATA "G        - Goto Bitmap Number"
DATA "S        - Set Grid Size"
DATA "8        - Scroll One Line Up"
DATA "2        - Scroll One Line Down"
DATA "4        - Scroll One Line Left"
DATA "6        - Scroll One Line Right"
DATA "------------------------------------------------"
DATA "F1       - Mirroring Options"
DATA "F2       - Select Plotting Colour"
DATA "F3       - Load Binary Data"
DATA "F4       - Merge Binary Data into Current Bitmap"
DATA "F5       - Save Current Bitmap as Binary Data"
DATA "F6       - Save All Bitmaps as Binary Data"
DATA "F7       - Save Current Bitmap to File"
DATA "F8       - Save All Bitmaps To File"
DATA "F9       - Save All Bitmaps into One Bitmap"
DATA "F10      - Copy graphic To Current Bitmap"
DATA "F11      - Clear Grid"
DATA "F12      - Exit Program"
DATA "*"