\ Bitmap-DOL  2/5/99

needs core-ext
needs ids
needs DataMgr
needs zstrings
needs struct

struct
  1 cells field i-width
  1 cells field i-height
  1 cells field i-bytes/line
  1 cells field i-flags
  4 cells field i-filler
 160 20 * chars field i-data \ max
end-struct bitmap:

20. 2constant p-bytes/line

2variable RscHandle
2variable PixDB
2variable RscDB
2variable Pixel
2variable DBPtr
2variable RHnd
2variable size
variable pic-no
bitmap: image

: ShowBitmap  ( y x  ID-no ID-type )
  DmGetResource
  2dup RscHandle 2!
  MemHandleLock  ( y x addr. )
  WinDrawBitmap
  RscHandle 2@ MemHandleUnlock
  throw
  RscHandle 2@ DmReleaseResource
  throw
 ;

: ShowImage ( y x -- )
  image >abs WinDrawBitmap
;

: GetImage ( h w n  -- )
  pic-no !
  image i-width !
  image i-height !
  image i-width @
  7 + 8 / dup 1 and +
  image i-bytes/line !
  image i-flags 10 0 fill
  dmModeReadOnly z" Pictures"
  OpenDB PixDB 2!
  pic-no @ PixDB 2@ DmGetRecord
  2dup RHnd 2!
  MemHandleLock
 114. D+ ( s. ) \ skip header stuff
  image i-height @ 0 do 2dup ( s. s. )
    image i-bytes/line @ s>d 2swap
    image i-bytes/line @ i *
    image i-data + >abs  ( s. u. s. d. )
    memmove throw
    p-bytes/line d+
  loop
  RHnd 2@ MemHandleUnLock throw
  false pic-no @ PixDB 2@
  DmReleaseRecord throw
  PixDB 2@ CloseDB
  ;

: SaveImage ( id icon? z-addr u  -- )
  2swap >r >r
  dmModeWrite rot rot
  OpenDB RscDB 2!
  image i-height @
  image i-bytes/line @ * 16 + s>d
  2dup size 2!
  r> r> if [id] tAIB else [id] Tbmp then
  RscDB 2@ DmNewResource
\ DmNewResource ( size. resID
\ resType. dbP. -- VoidHand. )
  2dup RHnd 2!
  MemHandleLock 2>r
\ DmWrite ( bytes. &srcP. offset.
\ &recordP. -- Err )
  size 2@  image >abs 0. 2r>
  DmWrite throw
  RHnd 2@ MemHandleUnLock throw
  RHnd 2@ DmReleaseResource
  throw
  RscDB 2@ CloseDB
  ;

: CopyImage
  40 65 0 getimage
  1001 false z" HcpResources"
  saveimage
\ page 80 10 showimage
;

: tt CopyImage ;