AmiBlitz³
bPaint (AMOS Recreation) mit Src - Druckversion

+- AmiBlitz³ (https://www.amiblitz.de/community)
+-- Forum: Blitzbasic2 (https://www.amiblitz.de/community/forum-5.html)
+--- Forum: Snippets & Libraries (https://www.amiblitz.de/community/forum-11.html)
+--- Thema: bPaint (AMOS Recreation) mit Src (/thread-208.html)



bPaint (AMOS Recreation) mit Src - hackball - 06.09.2020

Ich hab hier mal einen alten Sourcecode ausgebuddelt. Den hatte ich letztes Jahr oder so nochmal angefaßt zwecks Bugfixes oder so.

Kann vielleicht als hilfreiches Beispiel dienen.

Das ist in keinem Falle als ausgereiftes, fertiges Programm anzusehen! Blush 
[attachment=35]
Code:
.
.rev
;################################################################################
;#                                                                              #
;#  Source     :    bpaint_sys.bb                                         #
;#                                                                              #
;#  Description:    recreation of AMOS paint (unfinished)                                                #
;#                                                                              #
;#  Author     :    Frank Brandis                                               #
;#                                                                              #
;#  Exec       :    Blitz2:Execs/Foo                                            #
;#                                                                              #
;#  Date of                                                                     #
;#  Creation   :                                                                #
;#                                                                              #
;#  Date of                                                                     #
;#  Update(s)  :                                                                #
;#                                                                              #
;#                                                                              #
;#  To do      :                                                                #
;#                                                                              #
;#                                                                              #
;################################################################################
;
.his
;################################################################################
;#                                                                              #
;#  History    :                                                                #
;#                                                                              #
;#                                                                              #
;################################################################################
;

.
;################################################################################



;




;gadgets, modes

#up         =1
#down       =2
#left       =3
#right      =4
#tobuffer   =5
#frombuffer =6
#insertframe=7
#deleteframe=8
#playanim   =9
#save       =10
#load       =11
#freihand   =12
#bogen      =13
#linie      =14
#rechteck   =15
#ellipse    =16
#text       =17
#lupe       =18
#cut        =19
#rotier     =20
#flipx      =21
#flipy      =22
#clear      =23
#undo       =24
#info       =25

;windows

#picwin   =2
#toolwin  =1
#palwin   =3
#zoomwin  =4

NEWTYPE.box
x.w
y.w
w.w
h.w
End NEWTYPE

DEFTYPE.box statbar   ;statusbar

statbar\x=0,22,36*8+12,10

Dim palpen.box(32)     ;dims are added within drawpal{}


DEFTYPE.w

Dim modetxt$(30)
Read nummodes
For i=1 To nummodes
 Read modetxt$(i)
Next
Data.w 25
Data.s "up","down","left","right","tobuffer","frombuffer"
Data.s "insertframe","deleteframe","playanim","save"
Data.s "load","freihand","bogen","linie","rechteck","ellipse"
Data.s "text","lupe","cut","rotier","flipx","flipy","clear","undo","info"


MaxLen pa$=450
MaxLen fi$=180

.funcs
Statement clrstatus {col.w}
SHARED statbar.box
;Use Window #toolwin
USEPATH statbar

WBox \x+1,\y+1,\x+\w-1,\y+\h-1,col

USEPATH ycy

End Statement

Statement drawstatus {}
SHARED statbar.box
Use Window #toolwin
USEPATH statbar
;border
Wline \x,\y+\h,\x,\y,\x+\w,\y,2
Wline \x+\w,\y,\x+\w,\y+\h,\x,\y+\h,4
USEPATH ycy
End Statement


Statement status {txt$,col.w}
SHARED statbar.box
Use Window #toolwin
USEPATH statbar

clrstatus {3}

WindowOutput1

WLocate \x+3,\y+2
WColour col,3
Print   txt$

USEPATH ycy

End Statement

Statement drwstatus{mode.w}
SHARED nummodes.w
SHARED modetxt$()

If mode >0 AND mode<=nummodes
  status{">"+modetxt$(mode)+"<",1}
Else
  status{"?",7}
EndIf
End Statement

Statement drawrect{x1,y1,x2,y2,col}
Wline x1,y1,x2,y1,x2,y2,x1,y2,x1,y1,col
End Statement


Statement newscreen{wid.w,heid.w,dep.w,mode.l}
 SHARED d,w,h
 If w<320 Then w=320
 If h<256 Then h=256

 Screen #picwin,0,0,wid,heid,dep,mode,"",0,0
 ScreensBitMap #picwin,0

 ShowPalette #picwin

 d=dep:w=wid:h=heid
 Window #picwin,0,0,w,h,$800,"",1,0
 MenusOff
 Use BitMap 0:Cls

End Statement

CNIF0       ;vertical
Statement openpal{}
SHARED palstatus.b
If palstatus=0
  Use Screen #picwin
  Window #palwin,0,0,14,ScreenHeight,$802,"p",0,0
  palstatus=1
EndIf
End Statement

Statement drawpal{}
 Use Window #palwin
 WCls
 wh=212
 ws=wh/32
 c=0
 For gy=0 To wh Step ws
   WBox 0,gy,14,gy+ws-1,c
   c+1
 Next
End Statement
CEND

Statement openpal{}
SHARED palstatus.b
If palstatus=0
  Use Screen #picwin
  Window #palwin,0,0,ScreenWidth,14,$800,"",0,0
  palstatus=1
EndIf
End Statement

Statement drawpal{}
 SHARED palpen.box()

 Use Window #palwin
 WCls
 ww=WindowWidth
 ws=ww/32
 c=0
 For gx=0 To ww Step ws
   WBox gx,0,gx+ws-1,14,c

   palpen(c)\x=gx,y,ws-1,14

   c+1
 Next
End Statement

Function.w palhit {x.w,y.w}
 SHARED palpen.box()
 res.w=-1
 c=0
 USEPATH palpen(c)

 Repeat
   If RectsHit (x,y,1,1,\x,\y,\w,\h)
     res=c
   EndIf
   c+1
 Until c>32 OR res=>0

 USEPATH vxxx

 Function Return res ; -1 = FAIL !
End Function

._setup
AddIDCMP$10
AutoCookie On


;Format"00"
For gad=1To25
; LoadShape gad,"bpaintshps/bpaintshape."+Str$(gad),0
; LoadShape gad+25,"bpaintshps/bpaintshape."+Str$(gad+25),0
 InitShape gad,10,10,2
 InitShape gad+25,10,10,2

Next
;Format""
;SaveShapes1,50,"bpaint.shps"
;SavePalette0,"bpaint.pal"
LoadShapes1,"BlitzINC:_dat/bpaint.shps"
LoadPalette #toolwin,"BlitzINC:_dat/iff/bpaint.br"

LoadPalette #picwin,"ENV:dpaint32.col"


ShapeGadget 0,010,00,0  ,#up         ,01,1+25
ShapeGadget 0,010,11,0  ,#down       ,02,2+25
ShapeGadget 0,000,06,0  ,#left       ,03,3+25
ShapeGadget 0,020,06,0  ,#right      ,04,4+25
ShapeGadget 0,030,00,0  ,#tobuffer   ,05,5+25
ShapeGadget 0,068,00,0  ,#frombuffer ,06,6+25
ShapeGadget 0,106,00,0  ,#insertframe,07,7+25
ShapeGadget 0,144,00,0  ,#deleteframe,08,8+25
ShapeGadget 0,182,00,0  ,#playanim   ,09,9+25
ShapeGadget 0,263,00,0  ,#save       ,10,10+25
ShapeGadget 0,292,00,0  ,#load       ,11,11+25
ButtonGroup1
ShapeGadget 0,  0,33,512,#freihand   ,12,12+25:Toggle0,12,On
ShapeGadget 0, 19,33,512,#bogen,13   ,13+25   :Disable0,#bogen
ShapeGadget 0, 38,33,512,#linie,14   ,14+25
ShapeGadget 0, 57,33,512,#rechteck   ,15,15+25
ShapeGadget 0, 76,33,512,#ellipse    ,16,16+25
ShapeGadget 0, 95,33,512,#text       ,17,17+25:Disable0,#text
ShapeGadget 0,133,33,512,#cut        ,19,19+25

ShapeGadget 0,114,33,1  ,#lupe       ,18,18+25
ShapeGadget 0,152,33,0  ,#rotier     ,20,20+25
ShapeGadget 0,171,33,0  ,#flipx      ,21,21+25
ShapeGadget 0,190,33,0  ,#flipy      ,22,22+25
ShapeGadget 0,263,33,0  ,#clear      ,23,23+25
ShapeGadget 0,282,33,0  ,#undo       ,24,24+25
ShapeGadget 0,301,22,0  ,#info       ,25,25+25

LoadFont1,"Fiona.font",8

w.w=320
h.w=256

newscreen{w,h,5,0}


Screen #toolwin,0,211,320,45,3,0,"",0,0
ShowPalette #toolwin
RGB7,15,2,1
Window #toolwin,0,0,320,45,$1000|$800,"",0,0,0 ;toolbox
WindowFont1
MenusOff
WBox0,0,320,43,3:For gad=1To25:Redraw1,gad:Next gad

drawstatus{}

status{"Welcome to bPaint",7}
Delay_50


;Gosub getname

frontcol.w=1
backcol.w =0
drawcol=1

drawmod.b=#freihand

drwstatus{#freihand}

exit=0
.
.main
Repeat

ev.l=WaitEvent

If EventWindow=#picwin

  Select ev

    Case$10
      If frontpen=-1           ;brush
        wx=WMouseX:wy=WMouseY
        WJam3
        drawrect{wx-rx,wy-ry,wx+rx,wy+ry,frontcol}
        WaitTOF_
        drawrect{wx-rx,wy-ry,wx+rx,wy+ry,frontcol}
        WJam0
      EndIf

    Case$8
      Use Window #picwin
      oldx=WMouseX:oldy=WMouseY

      Select MButtons
        Case2
      ;    drawcol=backcol
          Gosub dodraw
        Case1
      ;    drawcol=frontcol
          Gosub dodraw
      End Select

    Default
      Gosub intuicodes
  End Select

Else

  Gosub intuicodes

EndIf

Until exit

CloseWindow #picwin:CloseWindow #toolwin
Free BitMap0
CloseScreen #picwin:CloseScreen #toolwin
End
.

.dodraw
  Select drawmod
    Case#freihand
      While Joyb(0)>0
        wx=WMouseX:wy=WMouseY
        If frontpen<>-1
          WPlot wx,wy,drawcol
          Wline oldx,oldy,wx,wy,drawcol
          oldx=wx:oldy=wy
        Else
          Use BitMap0
          ClipBlit0,wx,wy
        EndIf
      Gosub updatelup
      Wend

    Case#linie
      While Joyb(0)>0
        wx=WMouseX:wy=WMouseY
        WJam3
        Wline oldx,oldy,wx,wy,drawcol
        VWait:Wline oldx,oldy,wx,wy,drawcol
      Wend
      WJam0
      Wline oldx,oldy,wx,wy,drawcol

    Case#rechteck
      While Joyb(0)>0
        wx=WMouseX:wy=WMouseY
        WJam3
        drawrect{oldx,oldy,wx,wy,drawcol}
        VWait:drawrect{oldx,oldy,wx,wy,drawcol}
      Wend
      WJam0
        drawrect{oldx,oldy,wx,wy,drawcol}

    Case#ellipse
      While Joyb(0)>0
        wx=WMouseX:wy=WMouseY
        WJam3
        xrad=QAbs(oldx-wx):yrad=QAbs(oldy-wy)
        WEllipse oldx,oldy,xrad,yrad,drawcol
        VWait:WEllipse oldx,oldy,xrad,yrad,drawcol
      Wend
      WJam0

      WEllipse oldx,oldy,xrad,yrad,drawcol

    Case#cut
      While Joyb(0)>0
        wx=WMouseX:wy=WMouseY
        WJam3
        drawrect{oldx,oldy,wx,wy,drawcol}
        VWait:drawrect{oldx,oldy,wx,wy,drawcol}
      Wend
      WJam0

      If wx<oldx Then Exchange wx,oldx
      If wy<oldy Then Exchange wy,oldy
      If wx=oldx OR wy=oldy Then Goto cute
      GetaShape0,oldx,oldy,wx-oldx,wy-oldy
      MakeCookie0
      sw=ShapeWidth(0)
      sh=ShapeHeight(0)
      rx=sw/2:ry=sh/2
      Handle0,rx,ry
      frontpen=-1
      cute:
  End Select
Return
.
.intuicodes
Select ev
._mbut
  Case$8
    If EventWindow=#palwin
      res=palhit{WMouseX,WMouseY}

      If res>-1
        drawcol=res
        status{"col="+Str$(drawcol),1}
        Use Window #palwin
      EndIf

    EndIf
  Case$40
._gads
    Select GadgetHit
      Case #up
      Case #down
      Case #left
      Case #right
      Case #tobuffer
      Case #frombuffer
      Case #insertframe
      Case #deleteframe
      Case #playanim
      Case #save
      Case #load        :Gosub loadpic
      Case #freihand    :drawmod=#freihand
      Case #bogen
      Case #linie       :drawmod=#linie
      Case #rechteck    :drawmod=#rechteck
      Case #ellipse     :drawmod=#ellipse
      Case #text
      Case #lupe:If GadgetStatus(0,#lupe)Then Gosub openlup Else Gosub closelup
      Case #cut         :drawmod=#cut
      Case #rotier
      Case #flipx
      Case #flipy
      Case #clear
        ;Use BitMap0:Cls backcol
        Use Window #picwin:WCls

      Case #undo
      Case #info
    End Select
    drwstatus{drawmod}
  Case$400
._keys
    ev$=LCase$(Inkey$)
    Select ev$
      Case Chr$(27):exit=1   ;QUIT
      Case "p"
        If palstatus=0
          uwin=Used Window
          openpal{}
          drawpal{}
          Activate #picwin: Use Window #picwin
        Else
          CloseWindow #palwin:palstatus=0
          Use Window uwin
        EndIf
     ;   status{"Palette not implemented",7}
     ;   Delay_50
     ;   drwstatus{drawmod}
    End Select
End Select
Return
.
.loadpic
FindScreen0,"board"
g$=ASLFileRequest$("name of picture to load",pa$,fi$,pat$)
If g$<>""
  If ILBMInfo(g$)
    FlushEvents$400000
    VWait12
    CloseWindow #picwin
    VWait12
    Free BitMap0
    VWait12
    CloseScreen #picwin
    VWait12
    newscreen{ILBMWidth,ILBMHeight,ILBMDepth,ILBMViewMode}
    LoadBitMap0,g$,#picwin:ShowPalette #picwin
  EndIf
EndIf
Return
.
.openlup
Use Screen #picwin
Window #zoomwin,w/2,14,w/2,h-14-45,$800,"",0,0
WCls 1
; BitMap 1,320,256,d
; BitMap 2,320,256,d
Return

.closelup
; Free BitMap1
; Free BitMap2
CloseWindow#zoomwin
Use Window #picwin
Return



.updatelup:
;  Use BitMap 1: BitMapOutput1                        ;do actual zooming!
;  x=xm-azoom3 : y=ym-bzoom3                        ;subtract zoom width/height
;  If x<0 Then x=0                                      ;check for off screen
;  If y<0 Then y=0
;  If x>w-azoom Then x=w-azoom
;  If y>h-bzoom Then y=h-bzoom
;  Use BitMap0
;  Scroll x,y,azoom,bzoom,0,0,0                         ;grab the block
;  azoom2.w=azoom+8                                     ;increase to make
;  If azoom>320 Then azoom=320                          ; sure window will be full
;  ????? 1,2,0,0,azoom2,bzoom                      ;do X4
;  Use Window 0
;  BitMaptoWindow 2,2,0,0,0,0,windwmod,windh               ;copy zoom into window
;  windw.w=w/2
;  windh.w=h
;  windwmod.w=windw-(windw MOD zoom)
;  azoom.w=(windw)/4
;  bzoom.w=(windh)/4
;  azoom3=azoom ASR 1
;  bzoom3=bzoom ASR 1
Return

NoCli:CloseEd:WBStartup