OpenEuphoria

1. To Insolor and those interested in dos rescue programme

• Posted by Selgor Nov 25, 2012
• 3232 views

Hello. Selgor here. Insolor, I think you were instrumental in getting dos rescue running "again".

I was able to salvage my euphoria folder from a part disc "crash". In the folder, I found a programme I "hashed up" from the original polygon programme. It is two distinct polygons moving around the screen. The background and each polygon change colours. Each colour is distinct i.e all colours different. Written 10 years ago.

I thought you might like to include it in your dos rescue package.

All I did was place it in the downloaded dos rescue folder.

Works on win xp .

 
 
 
----------  Done in early 2001 ??  Selgor 
----------  Background , each polygon change colour 
----------  Each colour is different 
----------  Can have more figures 
------------------------------------------------------ 
 
----------  Added necessary includes for dos-rescue October 2012 ----------- 
 
---------------------------------------------------------------------------- 
 
without type_check 
include dos_rescue.ew as dos_rescue 
include select.e 
include machine.e 
include mouse.e 
dos_rescue:use_vesa(1) 
if graphics_mode(18)  then  end if 
constant X = 1, Y = 2 
sequence config 
integer nlines, npoints, spacing, solid,klr,kol,kolr,key 
 
procedure stall() 
  for i = 1 to 3750000 do  end for 
end procedure 
 
procedure colour() 
 
    klr=rand(15)  kol=rand(15)   kolr=rand(15) 
    if klr=kol or klr=kolr  then colour() 
      elsif kol=kolr or kol=klr then colour() 
         elsif kolr=klr or kolr=kol then colour() 
    end if 
     bk_color(kolr) 
end procedure 
 
colour() 
 
 
procedure dun() 
 
         mouse_pointer(0) 
         mouse_events(2) 
      if sequence(get_mouse()) then  abort(0) end if 
end procedure 
 
procedure poly_pattern() 
      sequence points,pts,deltas,dels,history,his 
      config = video_config() 
 
      pts=rand(repeat(config[VC_XPIXELS..VC_YPIXELS],npoints))+2 
      points = rand(repeat(config[VC_XPIXELS..VC_YPIXELS], npoints))+2 
      deltas = rand(repeat({2*spacing-1, 2*spacing-1}, npoints)) - spacing 
      dels=rand(repeat({2*spacing-1,2*spacing-1},npoints))-spacing 
      key = dos_rescue:get_key() 
      if get_key() = 27 then abort(0) end if      dun() 
      history = {} 
      his={} 
      dos_rescue:clear_screen() 
 
 
 
   key = dos_rescue:get_key() 
   while get_key() != 27 do 
	if length(history) >= nlines then 
	    polygon(0, solid, history[1]) 
	    history = history[2..nlines] 
	    dun() 
	end if 
	if length(his) >= nlines then 
	    polygon(0,solid,his[1]) 
	    his=his[2..nlines] 
	end if 
 
 
        polygon(klr,solid,pts) 
	polygon(kol, solid, points) 
        dun() 
        history = append(history, points) 
	his=append(his,pts) 
	points += deltas 
	pts+=dels 
 
 
	for j = 1 to npoints do 
	    if points[j][X] <= 0 or points[j][X] >= config[VC_XPIXELS] then 
	deltas[j][X] = -deltas[j][X] 
	    end if 
 
	    if points[j][Y] <= 0 or points[j][Y] >= config[VC_YPIXELS] then 
		deltas[j][Y] = -deltas[j][Y] 
	    end if 
 
	end for 
 
	for j = 1 to npoints do 
	    if pts[j][X] <= 0 or pts[j][X] >= config[VC_XPIXELS] then 
		dels[j][X] = -dels[j][X] 
	    end if 
 
            dun() 
 
 
	    if pts[j][Y] <= 0 or pts[j][Y] >= config[VC_YPIXELS] then 
		dels[j][Y] = -dels[j][Y] 
	    end if 
	end for 
 
        if rand(101) = 1 then colour()  end if 
              dun()   stall() 
 
   end while 
end procedure 
 
key = dos_rescue:get_key() 
while get_key() != 27 do 
    nlines = 6   npoints = 4   spacing = 15    solid=0 
    dun()      poly_pattern() 
 
    dun() 
end while 
 

Code shows how programmes can be modified.

Cheers. Selgor.

3. Re: To Insolor and those interested in dos rescue programme

• Posted by Insolor Nov 26, 2012
• 3172 views

Hello, Selgor. As far as I recall, dos rescue already has a similar demo prog "rescued" from the Eu 3.1.1 package, though without mouse event handling. Anyway I will try it in a few days and write what I think about it.

Now, the only comment. There must be task_yield() inside the empty for-loop:

for i = 1 to 3750000 do
    task_yield() 
end for 

because DOS can interrupt the program execution in order to handle some events like key presses or mouse clicks, while the dos rescue can't (for the current implementation). So a program must yield the execution to the event handling loop, except in loops with dos_rescue:get_key() or get_mouse() calls (because they do task_yield() itself).

5. Re: To Insolor and those interested in dos rescue programme

• Posted by Insolor Nov 27, 2012
• 3078 views

Selgor, I see there are two polygons in your program. It is possible to make nearly unlimited number of polys using a sequence of them.

Another thing is that there should be `include mouse_rescue.ew` instead of `include mouse.e` to use a mouse. mouse_rescue.ew contains routines equivalent to the ones from the mouse.e, except they are working in the windows environment. And even more, get_mouse() form the mouse_rescue.ew catches mouse wheel events.

I plan to make documentation for dos rescue, but unlikely I'll do this soon.

Btw, lately I've uploaded dos_rescue for Euphoria 4.* Win32 platform to bitbucket.org: https://bitbucket.org/insolor/dos_rescue

The package can be downloaded from the following link: https://bitbucket.org/insolor/dos_rescue/get/tip.zip

The main changes are:

• dropped Eu3 support (allows to use `override` in order use overrided builtins without explicit namespace qualifier i.e. without `dos_rescue:`)
• added full screen simulation mode (toggle with alt+enter)
• proportional zoom when the window is maximized and in the full screen mode (when possible)
• some minor improvements

Possible further improvements:

• True color (24bpp) support
• Multithreading to avoid explicit task_yield() calls. Although as I recall currently Euphoria interpreter isn't thread safe, so this is not easy to do.

7. Re: To Insolor and those interested in dos rescue programme

• Posted by Insolor Dec 20, 2012
• 2762 views

I think it's possible to create separate include file compatible with EU3. Anyway this has very low priority for me.

9. Re: To Insolor and those interested in dos rescue programme

• Posted by Insolor Dec 21, 2012
• 2778 views

for i = 1 to 3750000 do
    task_yield() 
end for 

In DOS age the common practice was to make pause with empty loops.

The problem here is that dos rescue library has a background task that handles windows' messages to the main window procedure. To allow the window response on events the main task must yield execution to the background task from time to time (at least every 100ms), so it's highly recomended to add task_yield() explicitly to such empty loops. Loops like `while get_key()<0 do end while` do not need task_yield() because the dosrescue's get_key() calls task_yield() itself:

override function get_key() 
-- override Euphoria built-in 
-- get next character sent to graphics window 
    integer c 
    if not window_ready then 
        return eu:get_key() 
    else 
        task_yield() 
        if length(char_buff) = 0 then 
            c_proc(Sleep,{delay}) 
            return -1 
        else 
            c = char_buff[1] 
            char_buff = char_buff[2..$] 
            return c 
        end if 
    end if 
end function 

11. Re: To Insolor and those interested in dos rescue programme

• Posted by Insolor Dec 21, 2012
• 2693 views

for i = 1 to 3750000 do
    task_yield() 
end for 

I agree with you. task_yield() inside an empty loop is rather a solution for legacy code. For windows the better way is a for-loop with a few iterations and with sleep(0.1) and task_yield() in it, eg. 5 second pause:

for i = 1 to 50 do 
    task_yield() 
    sleep(0.1) 
end for 

13. Re: To Insolor and those interested in dos rescue programme

• Posted by Insolor Dec 21, 2012
• 2696 views

In Euphoria tasks do not switch automatically (even so called realtime tasks). Every task (counting the main one) must explicitly task_yield() to allow the task scheduler consider which task will run next. Examine a small example. You can see both tasks are realtime, but anyway there is task_yield() in the main loop. Try to remove it, and the tasks will not run at all.

15. Re: To Insolor and those interested in dos rescue programme

• Posted by mattlewis (admin) Dec 21, 2012
• 2650 views

I/O! I/O! I/O! I/O! I/O! I/O! I/O! I/O! I/O! I/O!

/Balmer

17. Re: To Insolor and those interested in dos rescue programme

• Posted by useless_ Dec 21, 2012
• 2623 views

I appologise for attempting to contribute by suggesting a better way.

useless

19. Re: To Insolor and those interested in dos rescue programme

• Posted by Selgor Dec 25, 2012
• 2385 views

Hello Andreas.

Selgor here.

Happy holidays to you and your family.

Andreas , you may do whatever with the programme.

Just let me know where to find it .

I have taken a copy of the programme in this thread, just to see what it now does.

Go for it !.

Cheers. Selgor.

21. Re: To Insolor and those interested in dos rescue programme

• Posted by andi49 Dec 26, 2012
• 2414 views

http://euphoria.indonesianet.de/source.zip

You can use it as a replacement for EuWInGui with Eu4

My fault.This works:

----------  Done in early 2001 ??  Selgor  
----------  Background , each polygon change colour  
----------  Each colour is different  
----------  Can have more figures  
------------------------------------------------------  
  
----------  Added necessary includes for dos-rescue October 2012 -----------  
  
----------------------------------------------------------------------------  
  
 
include euwingui.ew 
 
constant VC_XPIXELS=5,VC_YPIXELS=6 
constant X = 1, Y = 2  
sequence config 
atom npoly,nlines, npoints, spacing, solid 
sequence deltas,history,poly,colpoly  
 
WindowType=NoBorderWin 
 
atom xmax,ymax,backpic 
 
xmax=ScreenWidth() 
ymax=ScreenHeight() 
 
Window("",0,0,xmax,ymax) 
 
 
constant blackback=NewMB(xmax,ymax) 
constant canvas=NewMB(xmax,ymax) 
backpic=Control(Picture,"",0,0,xmax,ymax) 
SetPic(backpic,Picture,blackback) 
 
 
function video_config() 
sequence ret_s 
	ret_s ={0,0,0,0,0,0,0,0,0} 
    ret_s[VC_XPIXELS]=xmax 
    ret_s[VC_YPIXELS]=ymax 
    return ret_s 
end function 
 
procedure colour()  
    for i=1 to length(colpoly)  do 
        colpoly[i]=rand(#FFFFFF)   
    end for 
 
    for x=1 to length(colpoly)-1 do 
        if equal(colpoly[x],colpoly[x+1]) then 
            colour() 
        end if 
    end for   
end procedure  
 
  
nlines = 6  npoints = 4 spacing = 15    solid=0 npoly=3 
       
     config = video_config()  
     poly=repeat(0,npoly) 
     deltas=repeat(0,npoly) 
     history=repeat(0,npoly) 
     colpoly=repeat(0,npoly) 
     colour()  
 
for i=1 to length(poly) do 
    poly[i]=rand(repeat(config[VC_XPIXELS..VC_YPIXELS],npoints))+2  
    deltas[i]=rand(repeat({2*spacing-1, 2*spacing-1}, npoints)) - spacing 
    history[i]={}  
end for 
 
 
 
procedure filled_polygon(atom col,atom fillflag,sequence points) 
sequence flat 
	flat={} 
    for i=1 to length(points)  do 
        flat=flat&points[i] 
    end for 
    SetDrawingMB(canvas) 
    SetPenColor(col) 
    DrawPolygon(flat,fillflag) 
end procedure 
 
procedure polygon(atom col,atom fillflag,sequence points) 
sequence flat 
	flat={} 
    if fillflag then 
        filled_polygon(col,fillflag,points) 
    else 
        for i= 1 to length(points)-1 do 
            flat=append(flat,points[i]&points[i+1]) 
        end for 
        flat=append(flat,points[1]&points[$]) 
        SetDrawingMB(canvas) 
        SetPenColor(col) 
        DrawMultiLine(flat) 
    end if 
end procedure 
 
 
   
procedure poly_pattern()  
     
    for i=1 to length(history) do 
        if length(history[i]) >= nlines then  
            polygon(0, solid, history[i][1])  
            history[i] = history[i][2..nlines]  
 
        end if  
    end for 
         
    for i=1  to length(history) do 
        history[i] = append(history[i], poly[i])  
        poly[i] += deltas[i]  
    end for 
     
    for i=1  to length(poly) do 
        polygon(colpoly[i], solid, poly[i])  
        for j = 1 to npoints do  
            if poly[i][j][X] <= 0 or poly[i][j][X] >= config[VC_XPIXELS] then  
        deltas[i][j][X] = -deltas[i][j][X]  
            end if  
  
            if poly[i][j][Y] <= 0 or poly[i][j][Y] >= config[VC_YPIXELS] then  
                deltas[i][j][Y] = -deltas[i][j][Y]  
            end if  
  
        end for  
    end for 
        if rand(101) = 1 then  
            colour()     
             
        end if  
        CopyMBToControl(canvas,0,0,xmax,ymax,backpic,0,0) 
end procedure  
       
 
SetWinTimer(25) 
while True do 
		WaitEvent() 
    if Event=Click then 
        CloseApp(0) 
    end if 
    if Event=Key then 
        if EventItem=KEY_ESCAPE then 
            CloseApp(0) 
        end if 
         
    end if 
    if Event=Time then 
        SetCur(0) 
        poly_pattern() 
    end if 
    if Event=Move then 
        SetCur(0) 
    end if 
end while 
 
CloseApp(0)  

Happy Holydays

Andreas

23. Re: To Insolor and those interested in dos rescue programme

• Posted by Selgor Jan 05, 2013
• 2197 views

Andreas . Selgor here.

I was wondering ?? . In euwingui. What is the code for the background colour of the window?.

I have used each of the following in previous progammes.

setWindowBackColor(Win,Yellow).

constant canvas = create( Pixmap, "", 0, 0,0, 1, 1, 0 ).

setBackColor(canvas, Parchment).

bk_color(kolr).

And.

This one is new to me .

SetPic(backpic,Picture,blackback).

So, I wonder if you can help ??.

I can't seem to find similar code in the euwingui.ew.

Look forward to a solution.

Cheers.

Selgor.

25. Re: To Insolor and those interested in dos rescue programme

• Posted by Selgor Jan 05, 2013
• 2174 views

Hello Andreas. Selgor here.

Below is the new programme. Background colour changes. All works fine.

Again , Thank You.

It is your programme anyway.

I hope you will let me "borrow" it.

All the best for the future.

Cheers. Selgor.

 
----------  Done in early 2001 ??  Selgor 
----------  Background , each polygon change colour 
----------  Each colour is different   
----------  Can have more figures   
------------------------------------------------------------------------------- 
 
----------  Added necessary includes for EuWinGui by Andreas (andi49) Jan 2013 
----------                   And Full Screen . 
------------------------------------------------------------------------------- 
   
  
include euwingui.ew  
  
constant VC_XPIXELS=5,VC_YPIXELS=6  
constant X = 1, Y = 2   
sequence config  
atom npoly,nlines, npoints, spacing, solid  
sequence deltas,history,poly,colpoly   
  
WindowType=NoBorderWin  
  
atom xmax,ymax,backpic,kolr 
  
xmax=ScreenWidth()  
ymax=ScreenHeight()  
  
Window("",0,0,xmax,ymax)  
  
  
constant blackback=NewMB(xmax,ymax) 
constant canvas=NewMB(xmax,ymax) 
backpic=Control(Picture,"",0,0,xmax,ymax) 
--SetPic(backpic,Picture,blackback) 
  
 
function video_config()  
sequence ret_s  
	ret_s ={0,0,0,0,0,0,0,0,0} 
    ret_s[VC_XPIXELS]=xmax  
    ret_s[VC_YPIXELS]=ymax  
    return ret_s  
end function  
  
procedure colour()   
    for i=1 to length(colpoly)  do  
        colpoly[i]=rand(#FFFFFF) 
    end for  
 
    kolr= rand(#FFFFFF) 
    SetPenColor(kolr) 
    SetDrawingMB(canvas) 
    DrawPolygon({0,0,xmax,0,xmax,ymax,0,ymax,0,0},True) 
 
    for x=1 to length(colpoly)-1 do 
        if equal(colpoly[x],colpoly[x+1]) then 
            colour() 
        end if 
    end for 
end procedure 
 
 
nlines = 6  npoints = 4 spacing = 15    solid=0 npoly=3 
 
     config = video_config() 
     poly=repeat(0,npoly)  
     deltas=repeat(0,npoly)  
     history=repeat(0,npoly)  
     colpoly=repeat(0,npoly)  
     colour()   
  
for i=1 to length(poly) do  
    poly[i]=rand(repeat(config[VC_XPIXELS..VC_YPIXELS],npoints))+2   
    deltas[i]=rand(repeat({2*spacing-1, 2*spacing-1}, npoints)) - spacing  
    history[i]={}   
end for  
  
  
  
procedure filled_polygon(atom col,atom fillflag,sequence points)  
sequence flat  
	flat={}  
    for i=1 to length(points)  do  
        flat=flat&points[i]  
    end for  
    SetDrawingMB(canvas)  
    SetPenColor(col)  
    DrawPolygon(flat,fillflag)  
end procedure  
  
procedure polygon(atom col,atom fillflag,sequence points)  
sequence flat  
	flat={}  
    if fillflag then  
        filled_polygon(col,fillflag,points)  
    else  
        for i= 1 to length(points)-1 do  
            flat=append(flat,points[i]&points[i+1])  
        end for  
        flat=append(flat,points[1]&points[$])  
        SetDrawingMB(canvas)  
        SetPenColor(col)  
        DrawMultiLine(flat)  
    end if  
end procedure  
  
  
    
procedure poly_pattern()   
      
    for i=1 to length(history) do  
        if length(history[i]) >= nlines then   
            polygon(kolr, solid, history[i][1]) 
            history[i] = history[i][2..nlines]   
  
        end if   
    end for  
          
    for i=1  to length(history) do  
        history[i] = append(history[i], poly[i])   
        poly[i] += deltas[i]   
    end for  
      
    for i=1  to length(poly) do  
        polygon(colpoly[i], solid, poly[i])   
        for j = 1 to npoints do   
            if poly[i][j][X] <= 0 or poly[i][j][X] >= config[VC_XPIXELS] then   
        deltas[i][j][X] = -deltas[i][j][X]   
            end if   
   
            if poly[i][j][Y] <= 0 or poly[i][j][Y] >= config[VC_YPIXELS] then   
                deltas[i][j][Y] = -deltas[i][j][Y]   
            end if   
   
        end for   
    end for  
        
        CopyMBToControl(canvas,0,0,xmax,ymax,backpic,0,0) 
        if rand(101) = 1 then 
            colour()      
              
        end if   
        CopyMBToControl(canvas,0,0,xmax,ymax,backpic,0,0)  
end procedure   
        
  
SetWinTimer(25)  
while True do  
		WaitEvent()  
    if Event=Click then  
        CloseApp(0)  
    end if  
    if Event=Key then  
        if EventItem=KEY_ESCAPE then  
            CloseApp(0)  
        end if  
          
    end if  
    if Event=Time then  
        SetCur(0)  
        poly_pattern()  
    end if  
    if Event=Move then  
        SetCur(0)  
    end if  
end while  
  
CloseApp(0) 
 

27. Re: To Insolor and those interested in dos rescue programme

• Posted by andi49 Jan 07, 2013
• 2036 views

Hallo

Just one thing, in colour() canvas is the handle to the Bitmap not a color, kolr is the backgroundcolor. But as you see, in this case (24-Bit colors, about 16,7 Million Colors) it is not very important to check for equal colors.

Andreas