PureBasic Forums - English

Posted: **Sat Oct 10, 2015 12:18 pm**

That I've done in my GetImage() / PutImage()

Posted: **Sat Oct 10, 2015 5:02 pm**

i just saw that - great!!!!!!!!!!!!!!!!!!!!!!!!!!!! (Wer lesen kann ist klar im Vorteil)

trying to put that into the new code - i am debugging all that crap (i did). if you want to try along , i post it. a lot of new stuff!

thanx again

Posted: **Sun Oct 11, 2015 11:25 am**

i had to abandon the new version - which i posted about.
i ported the code to modula (http://www.modula2.org/adwm2/download.php) and c it works. with pb 5.24 and the new beta, the program crashes unpredictable as with modula and c it does not, it works fine.
so i go back to the old code and but the page switching in it.

i tried a little test with the get/putimage and it seems, that i can't get it to run as wanted.
i paste the code i have to the first 3 messages.

Code: Select all

Procedure PutImageDemo()
  Protected r.i = 20, StartX.i = 100, StartY.i = 50
  Protected vp.viewporttype
  Protected.i PauseTime, x, y, ulx, uly, lrx, lry, size, i, width, height, Steps
  Protected Saucer.BITMAP
  GetViewSettings(@vp)
  ; Draw Saucer
  setfillstyle(#SOLIDFILL, getmaxcolor())
  fillellipse(StartX, StartY, r, (r/3)+2)
  Ellipses(StartX, StartY-4, 190, 357, r, r/3)
  Lines(StartX+7, StartY-6, StartX+10, StartY-12)
  Circles(StartX+10, StartY-12, 2)
  Lines(StartX-7, StartY-6, StartX-10, StartY-12)
  Circles(StartX-10, StartY-12, 2)
  ; Read saucer image
  ulx = StartX-(r+1)
  uly = StartY-14
  lrx = StartX+(r+1)
  lry = StartY+(r/3)+3
  width = lrx - ulx + 1
  height = lry - uly + 1
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;size = imagesize(ulx, uly, lrx, lry)
  ;Saucer = malloc( size )
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  getimage(ulx, uly, lrx, lry, @Saucer)
  putimage(ulx, uly, @Saucer, #OrMode)
  ; Plot some "stars"
  For i=0 To 1000
    putpixel(Random(GetMaxX()), Random(GetMaxY()), Random( GetMaxColor()-1 )+1) ; #Black)
  Next
  x = GetMaxX() / 2
  y = GetMaxY() / 2
  PauseTime = 70
  ; Until a key is hit
  While runlen < 100
    ; Draw the Saucer
    putimage(x, y, @Saucer, #OrMode)  ;  draw image
    Delay(PauseTime)
    putimage(x, y, @Saucer, #OrMode)  ; erase image
    ; Move Saucer
    Steps = Random(2*r)
    If (Steps/2) % (2 <> 0)
      Steps = -1 * Steps
    EndIf
    x = x + Steps
    Steps = Random(r)
    If (Steps/2) % (2 <> 0)
      Steps = -1 * Steps
    EndIf
    y = y + Steps
    If vp\x1 + x + width - 1 > vp\x2
      x = vp\x2-vp\x1-width + 1
    ElseIf x < 0
      x = 0
    EndIf
    If vp\y1 + y + height - 1 > vp\y2
      y = vp\y2-vp\y1-height + 1
    ElseIf y < 0
      y = 0
    EndIf
    INC(runlen)
  Wend
  Pause()
EndProcedure

any idea?

Posted: **Sun Oct 11, 2015 1:19 pm**

What should this doing:

Code: Select all

If (Steps/2) % (2 <> 0)

Do you mean

Code: Select all

(Steps/2) & $1

But if I divide something by 2 the result is always even.

And have you ever checked the values of x and y?

If not, do it.

And Or will never erase something:
0 Or 0 = 0
0 Or 1 = 1
1 Or 0 = 1
1 Or 1 = 1

I think you want Xor
0 Xor 0 = 0
0 Xor 1 = 1
1 Xor 0 = 1
1 Xor 1 = 0

The value of #OrMode is wrong for BitBlt.
See:
https://msdn.microsoft.com/en-us/librar ... 85%29.aspx

But that all does not what you want, because than the stars will be erased.
You need something like that:

Code: Select all

XIncludeFile "MINIBGI.pbi"

UseModule MINIBGI
EnableExplicit





Procedure PutImageDemo()
  Protected r.i = 20, StartX.i = 100, StartY.i = 50
  Protected vp.viewporttype
  Protected.i PauseTime, x, y, ulx, uly, lrx, lry, size, i, width, height, Steps
  Protected Saucer.BITMAP, Save.BITMAP
  Protected.f Angle
  
  Protected.i runlen
  
  GetViewSettings(@vp)
  
  ulx = StartX-(r+1)
  uly = StartY-14
  lrx = StartX+(r+1)
  lry = StartY+(r/3)+3
  width = lrx - ulx + 1
  height = lry - uly + 1
  
  getimage(ulx, uly, ulx + width, uly + height, @Save)
  
  ; Draw Saucer
  setfillstyle(#SOLIDFILL, getmaxcolor())
  fillellipse(StartX, StartY, r, (r/3)+2)
  Ellipses(StartX, StartY-4, 190, 357, r, r/3)
  Lines(StartX+7, StartY-6, StartX+10, StartY-12)
  Circles(StartX+10, StartY-12, 2)
  Lines(StartX-7, StartY-6, StartX-10, StartY-12)
  Circles(StartX-10, StartY-12, 2)
  ; Read saucer image
  
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;size = imagesize(ulx, uly, lrx, lry)
  ;Saucer = malloc( size )
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  getimage(ulx, uly, lrx, lry, @Saucer)
  putimage(ulx, uly, @Save)
  FreeMemory(Save\bmBits)
  ; Plot some "stars"
  For i=0 To 1000
    putpixel(Random(GetMaxX()), Random(GetMaxY()), Random( GetMaxColor()-1 )+1) ; #Black)
  Next
  x = GetMaxX() / 2
  y = GetMaxY() / 2
  PauseTime = 70
  ; Until a key is hit
  While runlen < 300
    ; Draw the Saucer
    ;Debug Str(x) + "," + Str(y)
    
    GetImage(x, y, x + width, y + width, @Save)
    putimage(x, y, @Saucer)  ;  draw image
    Delay(PauseTime)
    putimage(x, y, @Save)  ; erase image
    FreeMemory(Save\bmBits)
    ; Move Saucer
    
    x = (GetMaxX() >> 1) + Sin(Angle) * 100
    y = (GetMaxY() >> 1) + Cos(Angle) * 100
    
    Angle + 0.02
    If Angle > 6.28
      Angle = Angle - 6.28
    EndIf
    
    INC(runlen)
  Wend
  FreeMemory(Saucer\bmBits)
  
  ;Pause()
EndProcedure




Global x.d,xwin=800, ywin=800
Global Event.i, Quit.i, wnum.i,MaxX.i,MaxY.i,MaxRadius.i

InitGraph(xwin, ywin, "tester")
        
PutImageDemo()

; Repeat
;   Event = WaitWindowEvent()
;   If Event = #PB_Event_CloseWindow  ; If the user has pressed on the close button
;     Quit = 1
;   EndIf
; Until Quit = 1

And in general:
If you do not provide a working code, than I and maybe others don't invest additional time to
write it. So no one will test your code.

Bernd

Posted: **Sun Oct 11, 2015 1:32 pm**

your code is working (in general), i have tested the few examples available, and useful in trying the BGI code available sometimes in the web. so i suggest to consider the current version version 0.1 and keep it available, someone in the future may benefits from its techniques you and infratec have used. so it is not useless at all. any time in the future you can return to it. but rule No. 1 keep the code.
regards

PureBasic Forums - English

bgi and plot library

Re: bgi and plot library

Re: bgi and plot library

Re: bgi and plot library

Re: bgi and plot library

Re: bgi and plot library