imageFile/f/5th_eg

   1 .( loading graphic editor ) update\r
   2 \r
   3 D> \listF\listLIB\5TH_GFX2 modulechk\r
   4 D> \listF\listLIB\5TH_DRVMOUSE modulechk\r
   5 \r
   6 .( <file>               gedit           - load existing image )\r
   7 .( <Xsize> <Ysize>      geditnew        - start new image )\r
   8 .(                      EGh             - graphic editor help )\r
   9 \r
  10 var ghandle\r
  11 var sizex var sizey\r
  12 var zoomx var zoomy\r
  13 var zoomup\r
  14 var zoom\r
  15 var selcol\r
  16 var gbrush\r
  17 1 vari geditcycdir\r
  18 5 vari geditcyccur\r
  19 \r
  20 Dstral const EGfile\r
  21 str F1 - help"          msghelp\r
  22 str pick the color"     msgpick\r
  23 str draw pixels"        msgpix\r
  24 str fill with color"    msgfill\r
  25 Dstr \listF\TXT_EG"     tmphlpfile\r
  26 \r
  27 \r
  28 : EGh tmphlpfile fs. ;\r
  29 \r
  30 : gclose ghandle @ dup if dynde\r
  31 ghandle off else drop then ;\r
  32 \r
  33 : geditmsg ( addr -- )\r
  34 ghandle @ emitscreen !\r
  35 1A 3B at! 14 do space loop\r
  36 1A 3B at! write\r
  37 screen emitscreen ! ;\r
  38 \r
  39 : zoomupdate\r
  40 zoom @ if\r
  41         14 do\r
  42                 14 do\r
  43                         i 4 * 226 + dup 4 + i2 4 * 1+ dup 4 + ghandle @\r
  44                         i zoomx @ + i2 zoomy @ + screen point c@ boxf\r
  45                 loop\r
  46         loop\r
  47 then ;\r
  48 \r
  49 : selcoldisp 226 27F 55 64 ghandle @ selcol @ boxf ;\r
  50 \r
  51 var tmp1\r
  52 : grinit\r
  53 ghandle @ 0 = if 280 1E0 imgalloc ghandle ! then\r
  54 ghandle @ cls\r
  55 tmp1 off        ( display palette )\r
  56 24 do\r
  57         6 do\r
  58                 i2 5 * dup 5 + i 5 * 1C2 + dup 5 + ghandle @\r
  59                 tmp1 @ boxf\r
  60                 tmp1 @ 1+ tmp1 !\r
  61         loop\r
  62 loop\r
  63 [ FF FF FF calccol ] sizex @ 1+ 0 sizey @ 1+ 0 ghandle @ box\r
  64 [ FF FF FF calccol ] 276 225 51 0 ghandle @ box\r
  65 [ FF FF FF calccol ] selcol ! selcoldisp\r
  66 B4 C8 1C2 1DF ghandle @ FF boxf\r
  67 msghelp geditmsg ; rh tmp1\r
  68 \r
  69 : geditpict ( x y -- )\r
  70 push push\r
  71 1 i sizex @ bound? if\r
  72 1 i2 sizey @ bound? if\r
  73         gbrush @\r
  74         dup 2 = if selcol @ i i2 ghandle @ pset zoomup on then\r
  75             3 = if sizex @ sizey @ imgalloc\r
  76                    ghandle @ dynp over dynp -1 -1 vidput\r
  77                    dup push\r
  78                    selcol @ i2 1- i3 1- pop imgfill\r
  79                    dup dynp ghandle @ dynp 1 1 vidput\r
  80                    dynde\r
  81                    zoomup on then\r
  82 then then\r
  83 pop pop 2drop ;\r
  84 \r
  85 : gsavepict\r
  86 sizex @ sizey @ imgalloc                ( imgbuf )\r
  87 ghandle @ dynp over dynp -1 -1 vidput\r
  88 dup EGfile fsDsave\r
  89 dynde ;\r
  90 \r
  91 : ged\r
  92 ghandle @ if\r
  93 until\r
  94         ghandle @ dynp screen dynp 4B008 cmove\r
  95         zoomup @ if zoomupdate zoomup off then\r
  96 \r
  97         KBD_F@  dup 1+ if\r
  98                 dup 400 = if done then                          ( ESC )\r
  99                 dup 401 = if tmphlpfile fsdisp then             ( F1 )\r
 100                 dup 402 = if gsavepict then                     ( F2 )\r
 101                 dup 405 = if msgpick geditmsg 1 gbrush ! then   ( F5 )\r
 102                 dup 406 = if msgpix  geditmsg 2 gbrush ! then   ( F6 )\r
 103                     407 = if msgfill geditmsg 3 gbrush ! then   ( F7 )\r
 104         else drop then\r
 105 \r
 106         mousekeyr @ if\r
 107                 0 mousex @ A - sizex @ 12 - bound zoomx !\r
 108                 0 mousey @ A - sizey @ 12 - bound zoomy !\r
 109                 zoom on\r
 110                 ghandle @ emitscreen !\r
 111                 45 1D at!\r
 112                 zoomx @ . space\r
 113                 zoomy @ . space space space space\r
 114                 screen emitscreen !\r
 115                 zoomupdate\r
 116         then\r
 117 \r
 118         mousekeyl @ if\r
 119                 gbrush @ 1 = if\r
 120                         mousex @ mousey @ ghandle @ point\r
 121                         c@ selcol ! selcoldisp\r
 122                 else\r
 123                         225 mousex @ 276 bound? if\r
 124                         0 mousey @ 51 bound? if\r
 125                                 mousex @ 225 - 4 / zoomx @ +\r
 126                                 mousey @ 1- 4 / zoomy @ + geditpict\r
 127                         then then\r
 128                         mousex @ mousey @ geditpict\r
 129                 then\r
 130         then\r
 131 \r
 132         mousedo\r
 133         update\r
 134 \r
 135         geditcyccur @ geditcycdir @ + dup geditcyccur !\r
 136         dup dup dup FF setpal\r
 137         1 swap 3E bound? 0 = if geditcycdir @ neg geditcycdir ! then\r
 138 loop\r
 139 screen cls\r
 140 else\r
 141 ." no picture loaded" then ;\r
 142 \r
 143 : gedit ( file -- )\r
 144 dup EGfile str2Dstr ! fsDloadnew      ( imgbuf )\r
 145 dup imgsize sizey ! sizex ! grinit\r
 146 dup dynp ghandle @ dynp 1 1 vidput\r
 147 dynde ged ;\r
 148 \r
 149 : geditnew ( xsize ysize -- )\r
 150 sizey ! sizex !\r
 151 grinit ged ;\r
 152 \r
 153 \r
 154 rh tmphlpfile\r
 155 rh ghandle\r
 156 rh sizex rh sizey\r
 157 rh zoomx rh zoomy\r
 158 rh zoomup rh zoom\r
 159 rh gclose rh geditmsg\r
 160 rh zoomupdate rh selcoldisp\r
 161 rh grinit rh geditpict\r
 162 rh gsavepict rh ged\r
 163 rh selcol\r
 164 rh msghelp rh msgpix rh msgpick rh msgfill\r
 165 rh gbrush\r
 166 rh geditcycdir rh geditcyccur\r
 167 rh EGfile\r