Hallo, Gast
Du musst dich registrieren bevor du auf unserer Seite Beiträge schreiben kannst.

Benutzername
  

Passwort
  





Durchsuche Foren

(Erweiterte Suche)

Foren-Statistiken
» Mitglieder: 88
» Neuestes Mitglied: SadyeNob
» Foren-Themen: 287
» Foren-Beiträge: 2.592

Komplettstatistiken

Benutzer Online
Momentan sind 76 Benutzer online
» 0 Mitglieder
» 74 Gäste
Bing, Google

Aktive Themen
Frohe Ostern!
Forum: Off Topic
Letzter Beitrag: HelmutH
30.04.2025, 00:49
» Antworten: 1
» Ansichten: 139
https://www.amiblitz.de
Forum: Off Topic
Letzter Beitrag: HelmutH
18.03.2025, 21:20
» Antworten: 5
» Ansichten: 1.204
AmiBlitz 3.10.0 veröffent...
Forum: News
Letzter Beitrag: HelmutH
14.03.2025, 23:27
» Antworten: 0
» Ansichten: 409
readserial fail (bug ?)
Forum: Questions & Answers
Letzter Beitrag: hackball
13.03.2025, 18:23
» Antworten: 14
» Ansichten: 2.349
ReadSerialMem example (al...
Forum: Questions & Answers
Letzter Beitrag: hackball
06.03.2025, 17:31
» Antworten: 4
» Ansichten: 1.036
Diff View (MUI)
Forum: Showcase
Letzter Beitrag: hackball
02.03.2025, 13:03
» Antworten: 0
» Ansichten: 451
Foren Statistik
Forum: Off Topic
Letzter Beitrag: plouf
14.02.2025, 11:48
» Antworten: 10
» Ansichten: 3.182
WriteSerialString fails....
Forum: Questions & Answers
Letzter Beitrag: hackball
11.02.2025, 18:34
» Antworten: 11
» Ansichten: 3.180
listview in Os1.3
Forum: Questions & Answers
Letzter Beitrag: hackball
09.02.2025, 21:07
» Antworten: 11
» Ansichten: 2.999
AmySequencer - MIDI- und ...
Forum: Projects
Letzter Beitrag: HelmutH
06.02.2025, 23:52
» Antworten: 4
» Ansichten: 11.462

 
Lightbulb bPaint (AMOS Recreation) mit Src
Geschrieben von: hackball - 06.09.2020, 19:36 - Forum: Snippets & Libraries - Keine Antworten

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 
   

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



Angehängte Dateien
.lha   bpaint_assets.lha (Größe: 4,71 KB / Downloads: 1)
Drucke diesen Beitrag

Tongue MUI ShowBoards (Neuerstellung)
Geschrieben von: hackball - 28.03.2020, 05:02 - Forum: Showcase - Antworten (4)

Ich hatte eine Weile zurück mal das ShowBoardsMUI re-implementiert, war aber damals in Stocken gekommen wegen der unverständlichen Vorgehensweise bei mehrspaltigen Listen. Dies ist nun mittlerweile (endlich) gelöst, denke ich mal. Tongue 

Rob Cranley hat mir auf Anfrage den entscheidenden Tip gegeben. Siehe...https://amiblitz.de/community/thread-193.html

Meine Neuerstellung ist noch nicht fertig; das Projekt lag ja auch 3 Jahre still... Rolleyes 

Hier jedenfalls eine BETA.

Hinweis: Drucken (Print) geht nicht. Report (letztendlich) auch nicht. Die showboards-Datei in T: gibt es aber schonmal.

Nun, warum mache ich das? Ganz einfach:
ShowBoardsMUI wird nicht mehr weiterentwickelt und ist auch schon nicht mehr kompatibel zu neueren Versionen der boards.library.
Impressionen:
   

[Bild: attachment.php?aid=29]

       



Angehängte Dateien
.lha   muiShowBoards_beta.lha (Größe: 25,01 KB / Downloads: 2)
Drucke diesen Beitrag

  ASCII-Clip aus dem Aminet
Geschrieben von: hackball - 15.12.2019, 20:03 - Forum: Showcase - Antworten (2)

... habe ich mal etwas angepaßt.

Sourcecode ist im Original dabei, sehr seltsam teilweise, aber funktioniert.

WindowZoom funktioniert bei mir nicht, keine Ahnung, warum.

Quelle:
http://aminet.net/package/util/wb/ASCII-Clip

Ich habe den Topaz8 rausgeschmissen, jetzt sollte es einigermaßen fontsensitiv sein, außer, man hat überbreite Borders...

   
Immer noch kein LHA Support in diesem Forum, echt übel. Angry



Angehängte Dateien
.zip   ascii-clip112.lha.zip (Größe: 17,84 KB / Downloads: 1293)
Drucke diesen Beitrag

  Shapes vergleichen?
Geschrieben von: hackball - 15.12.2019, 00:08 - Forum: Showcase - Keine Antworten

Heute wollte ich endlich, wie schon lange geplant, ein paar Fonts rippen von Games.

Am Ende stellte sich raus, daß es Arbeit macht, die einzelnen Buchstaben zu separieren.

Da dachte ich mir: warum nicht ein Tool schreiben, das mir diese Arbeit abnimmt? Big Grin
   

Das lief zufriedenstellend.

Eine Funktion zur (Neu-)Verteilung auf eine BMap habe ich schon, in meinem ShapeExtractor-Tool. Nur noch zusammenbauen und wir haben den verregneten Samstag sinnvoll verschwendet. Cool

Drucke diesen Beitrag

Big Grin Blitz Profiler v1.0
Geschrieben von: hackball - 08.12.2019, 20:07 - Forum: Showcase - Antworten (3)

Ohje, ich hab endlich wieder ein Projekt fertig! Cool 

Und zwar hatte ich mal letztes Jahr in einem Forum einen PROFILER für Blitzbasic2 angedeutet. Der war im Prinzip damals schon fertig, ich mußte nur noch die Zeitmessung dazubauen. Da half mir dann noname/haujobb aus.

Wieauchimmer, ich habe es jetzt (mit den gegenwärtigen Spezifikationen) fertig.

Über die Distribution muß ich noch nachdenken, ist ja kein OpenSource aber kosten soll es natürlich auch nix.
Vielleicht ein Precompile-Include oder so.

Was tut es?

Es stellt einfache Methoden zur Verfügung, benutzte Prozeduren zu zählen und die darin verbrachte Zeit zu messen.
(man muß natürlich die für das Profiling selbst benutzte Zeit im Auge behalten).

Dafür fügt man in jede zu überwachende Prozedur einen "Entry" und am Ende einen "Exit" Aufruf ein.

Am Ende kann man (bisher) ein paar Statistiken ausgeben:

   

Schaut mal unten auf das Beispiel, das ist kurz und verständlich.

Da ist natürlich eine GUI geplant, und statistische Auswertungen und und und.

Ist vielleicht ganz sinnvoll?


Code:
;
;test of stat/debug/ profiler possibilities
;
;by frank b., germany
;
;the symbols have obscure names to not interfere
;  with others, as this is supposed to be "invisible",
;  like an include or something
;
;todo: add timer stuff to really measure somethin
;      add memdump/save instead of array()
;      add gui
;history
;      done timing support
;      seems like we are shipping this version!
;      08.DEC.2019

INCDIR  "BlitzINC:src/"
XINCLUDE"profiler_v06.bb"

;#############################################################

;CONTENS


;#bb__profilerON  =1    ;0=OFF

;#bb__PRO_maxfuncs=100

;Macro bbPRO_EntryFunc  ; {uniqueidname, display name of func}
;Macro bbPRO_ExitFunc

;Macro ProfilerStatsCLI

;including timer
;Macro bbPRO_EntryFuncT ; {uniqueidname, display name of func}
;Macro bbPRO_ExitFuncT
;

;#############################################################

.setup


#bb__profilerON = 1
.
.Test_Case


._testfunc
Statement testfunc1 {}

!bbPRO_EntryFuncT{tfunc1,"STAT: testfunc1"}

;---this is the original funcs routine--------------
NOP
Delay_5
;---------------------------------------------------

!bbPRO_ExitFuncT
End Statement

Statement testfunc2 {}

!bbPRO_EntryFuncT{tfunc2,"STAT: testfunc2"}

;---this is the original funcs routine--------------
NOP
Delay_5
;---------------------------------------------------

!bbPRO_ExitFuncT
End Statement


.main
CNIF #bb__profilerON
  bb_pro_starttimer{}
CEND

For a=1 To 5         ;runs our testfunction 5 times
  testfunc1{}
Next a

testfunc2{}          ;runs only one time

CNIF #bb__profilerON

!ProfilerStatsCLI    ;put out statistics

; For a=1To 10

;  NPrint "Time out:", bb_pro_gettime{}
;  Delay_5

; Next

CEND

NPrint "click mouse"

MouseWait

Drucke diesen Beitrag

  AmiBlitz3 Release: FPU-frei!
Geschrieben von: hackball - 04.12.2019, 21:30 - Forum: News - Antworten (7)

Offenbar hat jemand (Sven Dröge) die FPU-Abhängigkeiten rausgebaut!

Sehr fein, vielen Dank!

https://github.com/AmiBlitz/AmiBlitz3

SourceCode des 3.7 Release ist hier:

https://github.com/AmiBlitz/AmiBlitz3/re...tag/v3.7.0

Drucke diesen Beitrag

Star Argument in String Parsing, rekursiv
Geschrieben von: hackball - 10.11.2019, 20:20 - Forum: Snippets & Libraries - Keine Antworten

Ich habe mal ein simples Beispiel vorbereitet, das einzelne Teile aus einem String herauslöst. Man kann das z.B. benutzen als Argumentparser, Wortzähler usw..

Es nutzt hier nur Leerzeichen als Trenner, man kann das aber natürlich anpassen auf ganze Strings von Worttrennern, wenn man will.

Code:
;CMD parse test by f.brandis
;

DEFTYPE.w

;parsetest cmds

cmd$="dump from %s to           %d    a b cde 4 6 jj m , . ."

NPrint ">",cmd$,"<"


Function.w stripnparse{inp$}         ;recursive!

 SHARED nums

 inp$=StripLead$(inp$,32)           ;strip leading SPC

 If inp$="" Then Function Return0   ;nothing left!

 spc1.w=Instr(inp$," ")             ;another separator?

 If spc1>1                          ;any SPC at the end of this inp$?

   arg1$=Mid$(inp$,spc1)

   out$ =Left$(inp$,spc1-1)

   Gosub _strpnprsprt

   ok=stripnparse{arg1$}            ;down the rabbit hole...

 Else                               ;rest is an arg.

   out$=inp$

   Gosub _strpnprsprt

 EndIf


 Function Return nums               ;global count

_strpnprsprt:

 nums+1

 NPrint "Arg"+Str$(nums)+": >",out$,"<"

Return

End Function

NPrint "#args: ",stripnparse{cmd$}

MouseWait

End

CloseEd
   

Drucke diesen Beitrag

Wink Lemmings-like multi-obj
Geschrieben von: hackball - 19.10.2019, 01:45 - Forum: Snippets & Libraries - Keine Antworten

Hier mal ein Beispiel für eine Multi-Objekt (lemmings-like) Verwaltung(sehr simpel!).


WTF Wo ist mein Anhang?? Warum kann ich kein LHA anhängen??

   
Code:
;My Own Lemmings!!!!!

;-By F.Brandis
WBStartup:NoCli:CloseEd
BitMap1,320,256,4:BitMap0,320,256,4

dr$="blitzinc:_dat/"

LoadShapes0,dr$+"Lemms.shp"

dr$="blitzinc:_dat/iff/"

LoadBitMap0,dr$+"LemLev_b.iff",0

dr$="blitzinc:_dat/sfx/"

LoadSound0,dr$+"Lemm-Letsgo.sfx"

LoadSound1,dr$+"Lemm-Aehh!.sfx"
CopyBitMap0,1
VWait50
BLITZ
Slice0,44,4
Show0:Use Palette0

NEWTYPE.lemming
lemx.w
lemy.w
lemm.b       ;frame
dir.b
fall.b

bcount.b  ;new: bouncecount
End NEWTYPE

DEFTYPE.w

lan.b=40


Dim List l.lemming(lan)
USEPATH l()
While AddItem(l())
 Gosub randomlem
Wend

Buffer0,(lan+1)*50*5
Buffer1,(lan+1)*50*5
Sound0,15

Repeat

Show db.b:db=1-db:Use BitMap db
VWait:UnBuffer db
;o.b+1:If o>100Then Sound1,15:o=0
ResetList l()

While NextItem(l())
If Point(\lemx,\lemy+5)<4
  \lemy+2
  If \fall=3
    \lemm+1
    If \lemm<18
      \lemm=18
    Else
      If \lemm>21Then \lemm=18
    EndIf
  Else
    \fall+1
  EndIf

Else
  \fall=0

  Select \dir
    Case1
      \lemm+1:If \lemm>8Then \lemm=0
      If Point(\lemx+2,\lemy)>3           ;boing! hit wall
        If Point(\lemx+2,\lemy-1)=0
         \lemy-2
         If Point(\lemx+2,\lemy)>0
           \lemy-2
         EndIf
        Else
         \dir=2:\lemx-2
         \bcount+1
        EndIf
      Else
       \lemx+1
      EndIf
   Case2
      \lemm-1
      If \lemm<9
         \lemm=17
       Else
         If \lemm>17 Then \lemm=17
       EndIf
      If Point(\lemx-2,\lemy)>3           ;boing! hit wall
        If Point(\lemx-2,\lemy-1)=0
         \lemy-2
         If Point(\lemx+2,\lemy)>0
           \lemy-2
         EndIf
        Else
          \dir=1:\lemx+2
          \bcount+1
        EndIf       ;boing-handle
      Else
        \lemx-1
      EndIf
   Default
      Gosub randomlem
  End Select
EndIf

BBlit db,\lemm,\lemx,\lemy
If \bcount>4 Then Gosub bc_handle

If \lemy>200OR \lemx>310OR \lemx<10Then Gosub randomlem; KillItem l()
Wend
Until Joyb(0)>0
End

bc_handle:
\bcount=0
Gosub randomlem
Return

randomlem:
\lemm=0
\lemx=Rnd(300)+10
\lemy=5
rd.b=1-rd

\dir=rd+1
Return

.zip   OldLemmsTest.lha.zip (Größe: 27,81 KB / Downloads: 1380)

Drucke diesen Beitrag

  MUI: ImageButton (irgendwie)
Geschrieben von: hackball - 14.09.2019, 18:11 - Forum: Showcase - Antworten (2)

Ich hab' endlich den Imagebutton für das 5-Sterne-System in OBST runderneuert; jetzt funktioniert es. Big Grin 

Wird demnächst eingebaut. Es erfordert zur Zeit noch einen dirty HW-Zugriff auf den MouseButton, aber das fixe ich noch; da gibt es Timingprobleme oder so mit der Echtzeitabfrage via MUI.

Wird dann alsbald eingebaut.

Zur Info:
Es ist ein 5-Sterne-Voting-Button, der auch dragging erlaubt; er gibt 0-5 oder Fail=-1 zurück, als Resultat.
Er ist angedacht, um bei OBST jedes Game zu bewerten (wird im PAKs Ordner des Spiels gespeichert). Da ist bisher ein doofer CycleButton.

Hier ein exe als Beispiel zum Testen, bitte vom CLI starten wegen der Ausgabe!!

   


MultiColor bekomme ich nicht vernünftig hin; die Farben sind immer falsch, auch wenn es funktioniert. Ich habe hier aber noch MUI3.8, ob das mit 3.9 besser ist oder ggfls. mit NBitmap.mui, das probiere ich noch.



Angehängte Dateien
.zip   5starsmuitest.lha.zip (Größe: 15,72 KB / Downloads: 1230)
Drucke diesen Beitrag

  just some pixel art
Geschrieben von: bruZard - 10.09.2019, 20:24 - Forum: Showcase - Antworten (6)

[Bild: retro.jpg]

Drucke diesen Beitrag